Consulting

Results 1 to 4 of 4

Thread: Copy multiple workbooks & multiple sheets into single workbook with multiple sheets

  1. #1
    VBAX Newbie
    Joined
    Feb 2018
    Posts
    2
    Location

    Copy multiple workbooks & multiple sheets into single workbook with multiple sheets

    Hi!

    New to VBA here and trying to copy workbooks of the same format (but with varying number of rows) into a single workbook. Sheets are the same in the data files and need to be pasted into the corresponding sheets in the aggregated "monthly" file.

    So basically I have the following:

    Monthly Workbook -- contains macro / button to activate data aggregation

    Data files -- multiple files of same format, each with 7 sheets (unique names within workbook) of same names and headers (across workbooks) -- data needs to be appended together



    So far I have the following code. It is doing the first part ok - pasting in the first workbooks sheets, but I can't get it to append in the data from the subsequent data files. I am getting a "1004 Error Select Method of Worksheet class failed" on the line I have marked below.


    Option Explicit
    Sub CopyData()
    Dim erow As Long, lastrow As Long, lastcolumn As Long, WbMonthly As Workbook
    Dim TargetFiles As FileDialog
    Dim FileIdx As Long, DataBook As Workbook
    Dim sheet As Worksheet, counter As Long


    Set WbMonthly = ThisWorkbook


    'prompt user to select files
    Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
    With TargetFiles
    .AllowMultiSelect = True
    .Title = "Multi-select target data files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
    End With


    For FileIdx = 1 To TargetFiles.SelectedItems.Count
    'open the file and assign the workbook/worksheet
    Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))

    'if it is the first data file, copy in all of the sheets including the header row
    If FileIdx = 1 Then
    For Each sheet In DataBook.Sheets
    sheet.Copy After:=WbMonthly.Sheets(WbMonthly.Sheets.Count)
    Next sheet
    Else

    'if it is not the first data file, copy in the data by appending to what is already in the sheet
    For counter = 1 To DataBook.Sheets.Count
    DataBook.Sheets(counter).Select
    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

    WbMonthly.Sheets(counter + 1).Select 'ERROR
    erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(erow, 1).Select
    ActiveSheet.Paste
    Next


    End If

    Next




    'Close all of the datafiles
    For FileIdx = 1 To TargetFiles.SelectedItems.Count
    Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
    DataBook.Close
    Next



    End Sub



    Any help would be greatly appreciated!! THANK YOU!

  2. #2
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    What is the name of the sheet U want the data pasted to Your counter variable relates to the file U opened not the file that U want to put data into. HTH. Dave
    ps. Welcome to this forum. Please use code tags.

  3. #3
    VBAX Newbie
    Joined
    Feb 2018
    Posts
    2
    Location

    Hi Dave!

    Quote Originally Posted by Dave View Post
    What is the name of the sheet U want the data pasted to Your counter variable relates to the file U opened not the file that U want to put data into. HTH. Dave
    ps. Welcome to this forum. Please use code tags.

    Hi Dave!

    The data sheets that I want to copy are in 7 sheets that always have the same names. The workbook they are being copied into has a leading "Dashboard" sheet and then 7 sheets for the aggregated data.

    I tried to create a for loop that parsed through the data sheets in each workbook sequentially and put them in the aggregated sheet just offset by one sheet -- hence why in the later part of the text the data is pasted into WbMonthly in the sheets(counter + 1). This is also the line of code that I am getting an error on.

    The sheets in the data file have names like "Applications by category" and "Top operating systems by usage" but I would prefer to leave the code so that it is NOT dependent on the specific sheet names, but rather is more broadly able to copy and paste in data regardless of what the sheets are called.

    I don't know if I am activating the right workbooks? I am new to object oriented programming so I'm in a bit over my head I think.

    Also, sorry for not using code tags -- I didn't know that was a thing.

    Thanks for your help!

    Julia

  4. #4
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    Hi Julia. You can trial this. Dave
    Option Explicit
    Private Sub testthat()
    Dim FileNm As Object, Cnt As Integer
    Dim TargetFiles As FileDialog, sht As Worksheet, Cnt2 As Integer
    'prompt user to select files
     Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
     With TargetFiles
     .AllowMultiSelect = True
     .Title = "Multi-select target data files:"
     .ButtonName = ""
     .Filters.Clear
     .Filters.Add ".xlsx files", "*.xlsx"
     .Show
     End With
    If TargetFiles.SelectedItems.Count = 0 Then
     MsgBox "PICK A FILE!"
     Exit Sub
     End If
    On Error GoTo Below
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Cnt2 = ThisWorkbook.Sheets.Count
    For Cnt = 1 To TargetFiles.SelectedItems.Count
     'open the file and assign the workbook/worksheet
    Set FileNm = Workbooks.Open(TargetFiles.SelectedItems(Cnt))
    For Each sht In Workbooks(FileNm.Name).Worksheets
    sht.Copy After:=ThisWorkbook.Sheets(Cnt2)
    Cnt2 = Cnt2 + 1
    Next sht
    Workbooks(FileNm.Name).Close SaveChanges:=False
    Next Cnt
    Below:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then MsgBox "File Error"
    End Sub

    EDIT: Code reposted.
    Last edited by Dave; 02-19-2018 at 06:47 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •