ترحيل بيانات لملف الارشيف

[ابو حمادة]

ملف الارشيف :  Data.rar

ملف العمل  : تجربة.rar

[ابراهيم الحداد]

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

استخدم هذا الكود

Sub Date_To_Test()
Dim wbDate As Workbook, wbTest As Workbook
Dim Pat As String
Dim LR As Long, LS As Long
Application.ScreenUpdating = False
Set wbTest = ThisWorkbook
Pat = wbTest.Path & "\"
Set wbDate = Workbooks.Open(Pat & "Data" & ".xlsb")
Dim ws As Worksheet, Sh As Worksheet
Set ws = wbDate.Sheets("add")
Set Sh = wbTest.Sheets("add")
LR = Sh.Range("B" & Rows.Count).End(xlUp).Row
LS = ws.Range("B" & Rows.Count).End(xlUp).Row
Sh.Range("B" & LR + 1).Resize(LS - 5, 115).Value = _
ws.Range("B6:DL" & LS).Value
wbDate.Close False
Application.ScreenUpdating = True
End Sub

 

[صقرقريش89]

السلام عليكم 

من فضلكم اريد نسخ معادلات من ملف 1 الى ملف جديد في الاكسال 

المشكلة انه عند نسخ المعدلات تظهر لي في الملف الجديد بعنوانها في الملف الاول 

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

 

[احمدزمان]

شكرا جزيلا اخونا الفاضل الكريم زيزو العجوز

جزاك الله خيرا و احسن الله اليك

 

[ابراهيم الحداد]

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

و فيك بركة اخى الكريم احمد

شرفنى مرورك العطر

[ناصر سعيد]

جزاك الله خيرا استاذ زيزو

يحفظك ربنا

[ابراهيم الحداد]

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

بارك الله فيك اخى الكريم ناصر

[ابو حمادة]

في ٢٣‏/٣‏/٢٠١٨ at 10:47, زيزو العجوز said:

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

استخدم هذا الكود

Sub Date_To_Test()
Dim wbDate As Workbook, wbTest As Workbook
Dim Pat As String
Dim LR As Long, LS As Long
Application.ScreenUpdating = False
Set wbTest = ThisWorkbook
Pat = wbTest.Path & "\"
Set wbDate = Workbooks.Open(Pat & "Data" & ".xlsb")
Dim ws As Worksheet, Sh As Worksheet
Set ws = wbDate.Sheets("add")
Set Sh = wbTest.Sheets("add")
LR = Sh.Range("B" & Rows.Count).End(xlUp).Row
LS = ws.Range("B" & Rows.Count).End(xlUp).Row
Sh.Range("B" & LR + 1).Resize(LS - 5, 115).Value = _
ws.Range("B6:DL" & LS).Value
wbDate.Close False
Application.ScreenUpdating = True
End Sub

 

شكر استاذي الفاضل على هذا العمل

وجزاك الله كل خيرا وجعل هذا العمل فى ميزان حسناتك

جارى التجربه