Copying multiple cells between workbooks

[shakeregg]

Hey, I'm new to VBA and I'm wanting to transfer data from a number of workbooks (Sub Workbook 1, Sub Workbook 2, Sub Workbook 3 etc) to a main workbook (Database).

The location of the data contained within all the Sub Workbooks is the same (Sheet1 & A4:A52).

I'm wanting to paste this data into the main workbook which worksheet is called "Raw Data". Hopefully Sub Workbook 1 data will go in Column B4:52, Sub Workbook 2 data in column C4:52 etc etc.

Any help will be mostly appreciated!

Cheers all

 

[mumps]

What is the full path to the folder containing the source files? Are the source files the only files in that folder? What is the extension of the source files ("xlsx,xlsm,xls)?

 

[shakeregg]

Thank you for replying!

The full path to the folder containing the source files is: C:\Users\Laura\OneDrive\Documents\Database. This contains both the source files and the main workbook as well but that can be easily changed if needed. Also the file source is xlsm.

Thanks again!

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbSource As Workbook, wsDest As Worksheet
    Set wsDest = ThisWorkbook.Sheets("Raw Data")
    Dim lColumn As Long
    lColumn = 2
    Const strPath As String = "C:\Users\Laura\OneDrive\Documents\Database\"
    ChDir strPath
    strextension = Dir(strPath & "*.xlsm")
    Do While strextension <> ""
        If strextension <> ThisWorkbook.Name Then
            Set wkbSource = Workbooks.Open(strPath & strextension)
            With wkbSource
                .Sheets("Sheet1").Range("A4:A52").Copy wsDest.Cells(4, lColumn)
                lColumn = lColumn + 1
                .Close savechanges:=False
            End With
        End If
        strextension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Replace

lColumn = lColumn + 1

with

 lColumn = lColumn + 2