تعديل على كود ترحيل

[أبو قاسم]

السلام عليكم ورحمة الله وبركاتة 

اخواني الاعزاء  اذا تكرمتوا محتاج الى تعديل كود حيث كان الكود من قبل  يرحل البيانات الى ملف خارجي مسمى بيانات اريدة يرحل الى صفحة بنفس الملف مسماة بيانات وينقل التاريخ والفترة الى الاعمدة المحددة بالاصفر تعديل كود ترحيل.rar

تعديل كود ترحيل.rar

[الـعيدروس]

السلام عليكم

تفضل

Sub TransferDataToClosedWB()
    On Error Resume Next
    Dim WB As Workbook
    Dim LR_A As Long, LR_B As Long, LR_B2 As Long
    Dim Answer As Long
    LR_A = IIf(Cells(Rows.Count, 2).End(xlUp).Row = 1, 1, Cells(Rows.Count, 2).End(xlUp).Row)
    Application.ScreenUpdating = False
          ThisWorkbook.Sheets("التسجيل").Range("B9:L" & LR_A).Copy
'        Set WB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "البيانات.xlsm")
        Num_R = ThisWorkbook.Sheets("التسجيل").Cells(Rows.Count, 2).End(xlUp).Row - 9
        With Sheets("البيانات")
             LR_B = IIf(.Cells(.Rows.Count, 1).End(xlUp).Row = 1, 2, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
            .Range("A" & LR_B).PasteSpecial xlPasteValues
            .Range(.Cells(LR_B, "K"), .Cells(LR_B + Num_R, "K")).Value = Sheets("التسجيل").Range("F7").Value
            .Range(.Cells(LR_B, "L"), .Cells(LR_B + Num_R, "L")).Value = Sheets("التسجيل").Range("I7").Value
'            .Range(.Cells(LR_B, "n"), .Cells(LR_B + Num_R, "n")).Value = ThisWorkbook.Sheets("التسجيل").Range("i7").Value
        End With
        On Error GoTo 0
'    WB.Close SaveChanges:=True
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

تم تعديل ديسمبر 13, 2015 بواسطه الـعيدروس

[أبو قاسم]

تشكر ربنا يزيدك علما  صراحة روعة ماقصرت في تعاونك وابداعك