اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ارجو توضيح الكود


2saad

الردود الموصى بها

إخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمته وبركاته

لدي ملف به كود لجلب بيانات من ملفات أخري بناء علي مسار الملفات

ولكن أنا اريد أن اختارأوراق معينة من الملفات لأن الملفات بها أوراق كثيرة

فماذا أفعل لفعل ذلك ؟

ولكم جزيل الشكر ووافر الاحترامvba-macro-to-copy-data-from-multiple-files.xlsm

رابط هذا التعليق
شارك

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

جرب هذا التعديل

استبدل كودك بهذا الكود

Option Explicit

Sub GetData()
    Dim WhereToCopy As String, Col As String, CopyRange As String
    Dim dataWB As Workbook, currentWB As Workbook
    Dim WsData As Worksheet, WsResult As Worksheet, SH As Worksheet
    Dim FileName As String, lr As Long, i As Long
    Set currentWB = ThisWorkbook
    Set WsData = currentWB.Worksheets("List")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For i = 2 To WsData.Cells(Rows.Count, 2).End(xlUp).Row
        FileName = WsData.Range("C" & i) & WsData.Range("B" & i)
        CopyRange = WsData.Range("D" & i) & ":" & WsData.Range("E" & i)
        WhereToCopy = WsData.Range("F" & i)
        Col = Mid(WsData.Range("G" & i), 2, 1)
        Set WsResult = currentWB.Sheets(WhereToCopy)

        Application.Workbooks.Open FileName, UpdateLinks:=False, ReadOnly:=True
        Set dataWB = ActiveWorkbook

        For Each SH In dataWB.Worksheets(Array("كشف", "بيانات اساسية"))                    ' هنا تحدد اسماء الشيتات المراد نسخها
            SH.Range(CopyRange).Copy
            lr = WsResult.Cells(Rows.Count, Col).End(xlUp).Row + 1
            WsResult.Cells(lr, 1).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
            Application.CutCopyMode = False
        Next SH
        dataWB.Close False
    Next i
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information