لعيونك

نسأل الله من فضله

وعليكم السلام ورحمة الله وبركاته شكرا لتعاطفك ومرورك اخي الكريم ابوسليمان الله ييسر امرك وامري وأمر كل مسلم

وجدت موضوع آخر الكود بهذا الشكل Sub MovingToMyRow() On Error GoTo MyErr A = Application.WorksheetFunction.Match([B4], [B6:B23], 0) + 5 For c = 3 To 9 Cells(A, c) = Cells(4, c) Next MsgBox "!تم ترحيل البيانات إلى الصف المطلوب", vbInformation, "تم الترحيل" [B4].Select MyErr: If Err = 1004 Then MsgBox "!جميع الصفوف لا تحتوي على الرقم المطلوب ترحيل البيانات إليه", vbCritical, "رقم غير موجود" Exit Sub End If End Sub كيف يمكنني إضافة ورقتي عمل لأن المثال على ورقة عمل واحدة شكراً جزيلاً

وجدت هذا الموضوع ولم أستطع تعديل الكود ليناسب المهمة المطلوبة اسعفوني جزاكم الله خيراً

حتى الآن خرجت بهذا الكود Sub SignOUT() Dim VNum As String Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet Set ws = Sheets("FORM") Set ws2 = Sheets("DB") Dim erow As Long, i As Long LR = ws.Range("a" & Rows.Count).End(xlUp).Row LR2 = ws2.Range("a" & Rows.Count).End(xlUp).Row If ws.Range("G24").Value = "" Or ws.Range("H24").Value = "" Then MsgBox ("أكمل البيانات") Else Application.ScreenUpdating = False VNum = ws2.Range("G24").Value 'condition for copying For i = 2 To ws.Range("F" & Rows.Count).End(xlUp).Row 'Check if the row meets the condition If ws.Cells(i, 1) = VNum Then ws.Range(ws.Cells(i, 2), ws.Cells(i, 25)).Copy 'copy the row erow = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'find last row in ws2 ws2.Cells(erow, 1).PasteSpecial xlPasteFormulasAndNumberFormats 'paste only values End If Next i Application.CutCopyMode = False 'ws.Range("C24:H24").ClearContents MsgBox ("تم التسجيل") End If End Sub ولم يعمل بالشكل المطلوب

جزاكم الله عنا خيراً وجمعنا وإياكم في جنات ونهر عند مليك مقتدر

وجدت هذه الأكواد التي أظنها تقرب المهمة ترحيل بشرط Sub CopyBasedonSheet1() Dim i As Long Dim j As Long Sheet1LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row Sheet2LastRow = Worksheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Row For j = 1 To Sheet1LastRow For i = 1 To Sheet2LastRow If Worksheets("Sheet1").Cells(j, 1).Value = Worksheets("Sheet2").Cells(i, 4).Value Then Worksheets("Sheet1").Cells(j, 2).Value = Worksheets("Sheet2").Cells(i, 1).Value Worksheets("Sheet1").Cells(j, 3).Value = Worksheets("Sheet2").Cells(i, 2).Value Worksheets("Sheet1").Cells(j, 4).Value = Worksheets("Sheet2").Cells(i, 3).Value Else End If Next i Next j End Sub وهذا Sub CopyYes() Dim c As Range Dim j As Integer Dim Source As Worksheet Dim Target As Worksheet Dim Condition As Worksheet Set Source = ActiveWorkbook.Worksheets("source") Set Target = ActiveWorkbook.Worksheets("target") Set Condition = ActiveWorkbook.Worksheets("condition") j = 1 'This will start copying data to Target sheet at row 1 For Each d In Condition.Range("A1:A86") For Each c In Source.Range("B2:B1893") If d = c Then Source.Rows(c.Row).Copy Target.Rows(j) j = j + 1 End If Next c Next d End Sub وهذا Sub CopySPData() Dim c As Range Dim j As Integer Dim Source As Worksheet Dim Target As Worksheet ' Change worksheet designations as needed Set Source = ActiveWorkbook.Worksheets("All") Set Target = ActiveWorkbook.Worksheets("Host New") j = 3 ' Start copying to row 3 in target sheet For Each c In Source.Range("F1:F1000") ' Do 1000 rows If c = "Host" Then Source.Range("C" & c.Row & ":K" & c.Row).Copy Target.Range("E" & j) j = j + 1 End If Next c End Sub دعمكم يا أهل الأكواد بارك الله في الجميع

بارك الله في الجميع

لا إله إلا الله والحمدلله

تسجيل حضور بارك الله فيكم

شكراً لردك وتجاوبك أخي أحمد بارك الله في الجميع

السلام عليكم ورحمة الله وبركاته لدي خلية أريد نقل محتواها إلى عمود آخر عندما يتطابق نتيجة Lookup مع معلومات الأعمدة الأخرى هل أستطيع استخدام الكود التالي: Sub Test() Dim x On Error Resume Next x = WorksheetFunction.Lookup(Range(2), Range("A1:A5"), Range("A1:A5")) If Err = 0 Then MsgBox x Else MsgBox "Not found" Err.Clear End If On Error GoTo 0 End Sub الاختلاف لدي أن دالة Lookup بهذا الشكل =LOOKUP(2,1/($F:$F=$G$6),$D:$D) وهذا لأني أريد تحصيل آخر نتيجة مطابقة وتجاهل ما قبل رحم الله والديكم ووالدينا والمسلمين أجمعين مرفق الملف SEC_V3.xlsm

هل الموضوع يحتاج إيضاح أكثر، أرجو إرشادي تعودنا دعمكم اللامحدود وكرمكم في العلم منذ أكثر من عقد من الزمن جزاكم الله خيراً

لا إله إلا الله والحمدلله

السلام عليكم ورحمة الله وبركاته إن احتاج الأمر لتوضيح أكثر أرجو تنبيهي، اعتمادي على الله سبحانه وتعالى ثم عليكم، بارك الله فيكم ونفع بكم.

السلام عليكم ورحمة الله وبركاته بارك الله فيكم جميعاً وجمعنا وإياكم في جنات النعيم لدي ملف تسجيل دخول وخروج الزوار في الورقة الأولى (فورم) أقوم بترحيل بيانات الدخول للورقة الثانية (داتا) وفي نفس الورقة الأولى (فورم) يوجد تسجيل خروج الزائر أرغب في حال أضفت رقم بطاقة الزائر وتاريخ الخروج أن يتم ترحيل بيانات الخروج إلى جانب نفس بيانات الدخول المرحلة سابقاً مرفق الملف وجزاكم الله خيراًَ SEC_V2.xlsm

السلام عليكم ورحمة الله جزاك الله خيراً تفضل أخي قائمة مواقع رفع ملفات مجاناً بدون تسجيل https://uploadfiles.io/ http://wikisend.com/ http://www.tinyupload.com/ http://www.filedropper.com/ https://transfer.pcloud.com/ https://wetransfer.com/ http://www.zippyshare.com/ http://dropcanvas.com/

شكراً جزيلاً أستاذ سليم لا تسعفني الكلمات لأعبر لك عن خالص امتناني وشكري جزاك الله خيراً وبارك فيك تقبل احترامي وتقديري

جزاكم الله خيراً

لا إله إلا الله الإخوة الكرام كمحاولة عملت التالي: Sub CopyPaste() Sheets("Master").Range("A2").Copy Sheets("1").Range("F5").PasteSpecial xlPasteValues Sheets("Master").Range("B2").Copy Sheets("1").Range("F7").PasteSpecial xlPasteValues Sheets("Master").Range("C2").Copy Sheets("1").Range("K7").PasteSpecial xlPasteValues Sheets("Master").Range("D2").Copy Sheets("1").Range("F9").PasteSpecial xlPasteValues Sheets("Master").Range("E2").Copy Sheets("1").Range("F10").PasteSpecial xlPasteValues Sheets("Master").Range("F2").Copy Sheets("1").Range("K10").PasteSpecial xlPasteValues Sheets("Master").Range("G2").Copy Sheets("1").Range("F12").PasteSpecial xlPasteValues Sheets("Master").Range("H2").Copy Sheets("1").Range("K13").PasteSpecial xlPasteValues Sheets("Master").Range("I2").Copy Sheets("1").Range("F15").PasteSpecial xlPasteValues Sheets("Master").Range("J2").Copy Sheets("1").Range("K15").PasteSpecial xlPasteValues End Sub كيف يمكنني الآن إضافة عملية التكرار لينتقل للعمود التالي والورقة التالية؟ مرفق آخر تحديث بعد إزالة دمج الخلايا وإضافة الكود KPIs-Docs_3.zip

بانتظار مساعدتكم في تكرار عملية النسخ من الورقة الرئيسية إلى 400 ورقة فرعية وأكثر الأوراق الفرعية أسماءها تبدأ برقم 1 إلى 400 تقريباً قضيت اليوم بحثاً ولم أتوصل لشيء مرفق الملف بعد التحديث وإضافة الأوراق وإعادة تسميتها بالأكواد جزاكم الله خيراً وقضى حاجاتكم وحاجات المسلمين KPIs-Docs_2.zip

السلام عليكم الأخوة الكرام تم نسخ الشيت المطلوب وتكراره بهذا الكود Sub Copier2() Dim x As Integer x = InputBox("Enter number of times to copy Sheet1") For numtimes = 1 To x 'Loop by using x as the index number to make x number copies. 'Replace "Sheet1" with the name of the sheet to be copied. ActiveWorkbook.Sheets("000").Copy _ After:=ActiveWorkbook.Sheets("000") Next End Sub ثم تم تغيير اسم جميع الشيتس بهذا الكود Sub ChangeWorkSheetName() 'Updateby20140624 Dim Rng As Range Dim WorkRng As Range On Error Resume Next xTitleId = "KutoolsforExcel" newName = Application.InputBox("Name", xTitleId, "", Type:=2) For i = 1 To Application.Sheets.Count Application.Sheets(i).Name = newName & i Next End Sub إن وجد موضوع مساعد وميسر لعملية النسخ المتكررة أرجو إرشادي إليه شكراً جزيلاً

السلام عليكم ورحمة الله وبركاته تحية طيبة لكل الإخوة الفضلاء في هذا المنتدى المبارك،،، لدي ورقة عمل رئيسية باسم " Master " و ورقة عمل فرعية باسم " 000 " ليتم النسخ منها يوجد مجموعة أعمدة في الرئيسية أحتاج نسخ محتوى كل صف واحد إلى ورقة عمل جديدة منسوخة من الفرعية على فرض أن الكود يعمل التالي: 1- ينسخ ورقة العمل " 000 " لنسخة جديدة باسم " 001 " 2- ينسخ محتويات الصف " 2 " في " Master " إلى ورقة العمل الجديدة " 001 " 3- خلية " A2 " في Master إلى " F5 " في 001 ،،،، 4- خلية " A3 " في Master إلى " F7 " في 001 ،،،، 5- خلية " A4 " في Master إلى " K7 " في 001 ،،،، وهكذا حتى انتهاء الخلايا 6- يعيد نسخ الورقة الفرعية " 000 " إلى نسخة جديدة باسم " 002 " ويعيد عملية النسخ ،، وهكذا ،،،، مرفق المثال مع الشكر والتقدير وبالغ الامتنان KPIs-Docs---FUNCTION.zip

بارك الله فيكم وجازاكم عنا بالخيرات شكرا وعرفانا

بارك الله فيكم، والله إني لمحرج لإكثاري عليكم رجاء أخير، هل بالإمكان تجاهل القيم التي تساوي 0