waleedsh3alan قام بنشر نوفمبر 20, 2023 مشاركة قام بنشر نوفمبر 20, 2023 ارجو من الاساتذه الكبار كود ترحيل من ملف الاذون الى الصرف والاضافه بمعلوميه خليه c2 مخزن.xlsx رابط هذا التعليق شارك More sharing options...
أفضل إجابة ياسر خليل أبو البراء قام بنشر نوفمبر 20, 2023 أفضل إجابة مشاركة قام بنشر نوفمبر 20, 2023 السلام عليكم نبدأ بها جرب الكود التالي Sub Test() Dim ws As Worksheet, sh As Worksheet, sTarget As String, lr As Long, m As Long, iRow As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("اذن") lr = ws.Cells(Rows.Count, 1).End(xlUp).Row If lr < 6 Then MsgBox "No Data", vbExclamation: Exit Sub Select Case ws.Range("C2").Value Case "اذن صرف": sTarget = "صرف" Case "اذن اضافه": sTarget = "اضافه" Case Else: MsgBox "No Such Worksheet", vbExclamation: Exit Sub End Select Set sh = ThisWorkbook.Worksheets(sTarget) m = sh.Cells(Rows.Count, "B").End(xlUp).Row + 1 For iRow = 6 To lr sh.Range("A" & m).Resize(, 6).Value = Array(sh.Range("A" & m).Row - 2, ws.Range("E2").Value, ws.Range("C4").Value, ws.Range("C3").Value, ws.Cells(iRow, 1).Value, ws.Cells(iRow, 2).Value) sh.Range("I" & m).Value = ws.Cells(iRow, 4).Value If sh.Name = "اضافه" Then sh.Range("J" & m).Value = ws.Cells(iRow, 5).Value End If m = m + 1 Next iRow Application.ScreenUpdating = True MsgBox "Done", 64 End Sub 2 1 رابط هذا التعليق شارك More sharing options...
waleedsh3alan قام بنشر نوفمبر 22, 2023 الكاتب مشاركة قام بنشر نوفمبر 22, 2023 ياسر خليل أبو البراء لك جزيل الشكر على ماقمتم به وذادكم الله من فضله رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.