0
votes

I am completely newbie to VBA however I was given a task to complete using VBA. How do I create a code which copies the data of multiple worksheets from different workbooks and pastes them into another workbook (master data file) by adding exactly the same number of separate worksheets to this master data file? That is, I would like to display all of those worksheets being copied over to separate worksheets in the master data file.

I have managed to pull off a code which copies the data over and pastes it into one single worksheet but I am struggling to get them copied over one by one to separate worksheets.

Your help is much appreciated.

Sub datatransfer()

    Dim FolderPath, FilePath, Filename, targetfile As String
    Dim wb1, wb2 As Workbook
    Dim i, mycount As Long

    targetfile = "Left the location out on purpose"
    FolderPath = " Left the location out on purpose "
    FilePath = FolderPath & "*.xls*"

    Filename = Dir(FilePath)

    Dim lastrow, lastcolumn As Long

    Do While Filename < ""

        mycount = mycount + 1

        Filename = Dir()

        Set wb1 = Workbooks.Open(FolderPath & Filename)

        lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

        lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

        Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy

        Application.DisplayAlerts = False

        Set wb2 = Workbooks.Open(targetfile)

        Worksheets.Add Before:=Sheet1, Count:=2


        For i = 1 To mycount

            With Worksheets(i)

                ActiveSheet.Paste Destination:=.Range(Cells(2, 2), Cells(2, lastcolumn))

            End With

        Next i

        ActiveWorkbook.Close SaveChanges:=True

        Filename = Dir

    Loop

End Sub
1

1 Answers

0
votes

See the code below. I made several notes where I modified the code a bit to ensure it works with hitches going forward.

Sub datatransfer()

    'have to specify type for all variables, techinically it still works the way you did, but you are setting unncessary memory
    Dim FolderPath As String, FilePath As String, Filename As String, targetfile As String
    Dim wb1 As Workbook, wb2 As Workbook

    targetfile = "Left the location out on purpose"
    FolderPath = " Left the location out on purpose "
    FilePath = FolderPath & "*.xls*"

    Set wb2 = Workbooks.Open(targetfile) 'only need to open this once and leave open until execution is finished

    Filename = Dir(FilePath)

    Do While Filename <> "" ' need "<>" to say not equal to nothing

        wb2.Worksheets.Add After:=wb2.Worksheets(wb2.Worksheets.Count) 'add new sheet to paste data in target book

        Set wb1 = Workbooks.Open(FolderPath & Filename)

        Dim lastrow As Long, lastcolumn As Long

        With wb1.Worksheets(1) 'best to qualify all objects and work directly with them
            lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column

            'pretty sure you want to add this A1, since it's a new blank sheet
            .Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy _
                Destination:=wb2.Worksheets(wb2.Worksheets.Count).Range("A1")

        End With

        wb1.Close False 'assume no need to save changes to workbook you copied data from

        Filename = Dir

    Loop

    wb2.Close True 'no close and save master file

End Sub