احتاج نقل جدول من صفحة شيت الى شيت اخر وهو مغلق

[omhamzh]

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

احتاج الى عملية عكسية نقل البيانات من a2:f10000 من الملف من الموجود فى المجلدdoالى الملف الى الموجود خارجه لان به كود اخر ينقل العمودg من الملف الى بخارج المجلدdo الى الملف من

نفس فكرة getdata الموجودة فى الاكسيل بس بالVBA

حفظكم الله وبارك لنا فيكم خبراء المنتدى الاجلاء الافاضل

 

من الى.rar

تم تعديل يناير 22, 2021 بواسطه omhamzh

[omhamzh]

الكود لمن يحتاجه ويعمل تمام

بس عند تغير عدد الصفوف  الى 15000

بياخد وقت طويل

السادة الاساتذة حل للحلقة التكرارية لجعل الكود اسرع بارك الله فيكم

مع الشكر

Option Explicit

Sub GetDataDemo()

      Dim FilePath$, Row&, Column&, Address$
      Dim mpth
      Dim mfL
      'change constants & FilePath below to suit
      '***************************************
      Const FileName$ = "**"
      Const SheetName$ = "ورقة1"
      Const NumRows& = 10
      Const NumColumns& = 10
      Dir (mpth & "*xls*")
      mpth = ThisWorkbook.Path & "\do\"
      mfL = Dir(mpth & "*xls*")
      '***************************************
      
      DoEvents
      Application.ScreenUpdating = False
      If Dir(mpth & mfL) = Empty Then
            MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
            Exit Sub
      End If
      For Row = 1 To NumRows
            For Column = 1 To NumColumns
                  Address = Cells(Row, Column).Address
                  Cells(Row, Column) = GetData(mpth, mfL, SheetName, Address)
                  Columns.AutoFit
            Next Column
      Next Row
      ActiveWindow.DisplayZeros = False
End Sub

Private Function GetData(Path, File, Sheet, Address)
      Dim Data$
      Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
            Range(Address).Range("A1").Address(, , xlR1C1)
      GetData = ExecuteExcel4Macro(Data)
End Function