Home > Enterprise >  Copy and paste data from multiple workbooks located in the same folder to several worksheets of a pr
Copy and paste data from multiple workbooks located in the same folder to several worksheets of a pr

Time:01-18

Please, I am wondering if I can get some help with a VBA code which can perform the following actions:

Copy and paste data from multiple workbooks located in the same folder to several worksheets of a pre-existing workbook.

I have a folder in my C drive containing 10 workbooks. Each workbook file is named as:

  • Workbook_A_01
  • Workbook_A_02
  • Workbook_A_03
  • Workbook_A_04
  • Workbook_A_05
  • Workbook_A_06
  • Workbook_A_07
  • Workbook_A_08
  • Workbook_A_09
  • Workbook_A_10

All the workbooks in the folder are similar (one worksheet, fixe range of data, same headers…). I would like to use the pre-existing workbook which has 11 empty worksheets named as:

  • Overview
  • 01
  • 02
  • 03
  • ...
  • 10

From each workbook_A_XX, I would like to copy the same range of data (A200:E600) and past it into the pre-existing workbook as:

From Workbook_A_01, copy range (A200:E600) and paste it in the pre-existing workbook, into the sheet ‘‘01’’ starting at cell C6

From Workbook_A_02, copy range (A200:E600) and paste it in the pre-existing workbook into the sheet ‘‘02’’ starting at cell C6

From Workbook_A_03, copy range (A200:E600) and paste it in the pre-existing workbook into the sheet ‘‘03’’ starting at cell C6 ...

From Workbook_A_10, copy range (A200:E600) and paste it in the pre-existing workbook into the sheet ‘‘10’’ starting at cell C6

Many thanks.

I am new in VBA. The only thing I can do it to merge all the workbooks into one. It works but unfortunately, buy running the code, I cannot select a specific range from each workbook to be copied and pasted to the targeted location.

CodePudding user response:

Please, always post your code even if it does not work:

Sub alwayspostyourcode()

Dim wbSource As Workbook
Dim wbtarget As Workbook

Set wbtarget = ThisWorkbook 'assuming the workbook with the macro is the destination


For i = 1 To 10

    strI = Right("0" & Trim(Str(i)), 2)
    Set wbSource = Workbooks.Open("Workbook_A_" & strI & ".xlsx")
    wbSource.Sheets(1).Range("A200:E600").Copy Destination:=wbtarget.Sheets(strI).Range("C6")
    wbSource.Close
Next i

End Sub

CodePudding user response:

Import From Closed Workbooks

Option Explicit

Sub ImportData()

    Const SRC_FOLDER_PATH As String = "C:\Test\"
    Const SRC_WORKSHEET_ID As Variant = 1
    Const SRC_RANGE As String = "A200:E600"
    Const DST_FIRST_CELL As String = "A6"
    
    Dim swbNames(): swbNames = VBA.Array("Workbook_A_01.xlsx", _
        "Workbook_A_02.xlsx", "Workbook_A_03.xlsx", "Workbook_A_04.xlsx", _
        "Workbook_A_05.xlsx", "Workbook_A_06.xlsx", "Workbook_A_07.xlsx", _
        "Workbook_A_08.xlsx", "Workbook_A_09.xlsx", "Workbook_A_10.xlsx")
    Dim dwsNames(): dwsNames = VBA.Array("01", "02", "03", "04", _
        "05", "06", "07", "08", "09", "10")
        
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook, sws As Worksheet, srg As Range
    Dim dws As Worksheet, dfCell As Range
    Dim n As Long
    
    For n = 0 To UBound(swbNames)
        
        Set swb = Workbooks.Open(SRC_FOLDER_PATH & swbNames(n))
        Set sws = swb.Worksheets(SRC_WORKSHEET_ID)
        Set srg = sws.Range(SRC_RANGE)
        
        Set dws = dwb.Worksheets(dwsNames(n))
        Set dfCell = dws.Range(DST_FIRST_CELL)
        
        srg.Copy dfCell
        
        swb.Close SaveChanges:=False
    
    Next n
    
    Application.ScreenUpdating = True
    
    MsgBox "Data imported.", vbInformation

End Sub
  • Related