نقل بيانات اكثر من شيت على التوالى

[ابو يحيى1]

الاخوة الاعزاء

هل يمكن نقل بيانات اكثر من شيت فى شيت واحد على التوالى

اى بعد انتهاء بيانات الشيت الاول تبداء المعادلة بكاتبة بيانات الشيت الثانى بالترتيب .

ومرفق ملف لتوضيح المطلوب .

DATA.rar

 

[سليم حاصبيا]

جرب هذا الكود

Option Explicit

Sub tarnsfer_Data()
Dim My_rg As Range
Dim i%
Dim fisrt_row: fisrt_row = 1
Sheets("Sheet3").Range("a1").Resize(500, 10).ClearContents
 For i = 1 To Sheets.Count
    If Sheets(i).Name <> "Sheet3" Then
      Set My_rg = Sheets(i).Range("a2").CurrentRegion
      Sheets("Sheet3").Cells(fisrt_row, My_rg.Columns.Count + 1) = _
      "Begining of  " & Sheets(i).Name
      Sheets("Sheet3").Range("a" & fisrt_row). _
      Resize(My_rg.Rows.Count, My_rg.Columns.Count).Value = _
       My_rg.Value
      fisrt_row = fisrt_row + My_rg.Rows.Count + 1
      Sheets("Sheet3").Cells(fisrt_row - 2, My_rg.Columns.Count + 1) = _
      "End of  " & Sheets(i).Name
    End If
  Next
End Sub

الملف مرفق

 

DATA.xlsm

[Ali Mohamed Ali]

ممتاز بالتأكيد دائما وابدا مبدع عمل رائع أستاذ سليم جعله الله في ميزان حسناتك

[ابو يحيى1]

احسنت والله استاذنا سليم وهذا ما عهدناه دائما منك بارك الله لك .

بالرغم من ان استخدام الكود افضل فى هذه الحالة وهو ما ابدعتم فيه 

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

تم تعديل أبريل 7, 2019 بواسطه ابو يحيى1

[Ali Mohamed Ali]

على الرغم ان ملف الأستاذ سليم لا يعلى عليه ودائما الأكواد تكون افضل واسرع في العمل 

الا ان بناءا على كلبك فهذا العمل بالمعادلات

 

DATA.xlsx

[ابو يحيى1]

مشكور وجزاك الله خيراً أستاذ على .

مجهود ممتاز استفدت منه جدا وتعلمت الجديد .

بارك الله لك استاذنا الفاضل .