Consolidate info from columns into spreadsheet

[smd71092]

Hello all! I am working with the below code to attempt consolidating all of the Excel files within a folder (File1, File2, etc.). I have created and renamed sheets in the blank workbook (named "cExcelFiles") to match the sheets in the files I will be copying data from. The sheets all share the same first column so that has been copied and pasted manually into "cExcelFiles". The code breaks at Range.Copy Destination.

Ideally, this macro would cycle through each Excel file in the folder and copy columns B & C (maybe there's also a way to only copy down to the last row used in the columns) from each sheet and paste this over in the sheet of the same name in "cExcelFiles" and I want to know how I can get it so that as it loops through the Excel files, it will go into the next empty column to paste the next file's columns, if that makes sense. So File1 'SheetA' columns B&C would go into "cExcelFiles" 'SheetA' columns B&C, File2 'SheetA' columns B&C would go into "cExcelFiles" 'SheetA' columns D&E, File3 'Sheet A' columns B&C would go into "cExcelFiles" 'Sheet A' columns F&G, etc.

I am not an expert in VBA by any means but have had some experience working with it and would appreciate any help at all in how to go about this. Thanks so much!

Option Explicit

Sub CombineFiles()

Dim FolderPath      As String
Dim FileName        As String
Dim Wkb             As Workbook
Dim WS              As Worksheet
Dim FolderPicker    As Object
Dim FilesInPath     As String

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim intChoice As Integer
    Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
    FolderPicker.AllowMultiSelect = False
    'make the file dialog visible to the user
    intChoice = FolderPicker.Show
    'determine what choice the user made
    If intChoice <> 0 Then
    'get the folder path selected by the user
    FolderPath = Application.FileDialog( _
        msoFileDialogOpen).SelectedItems(1)
    Else: End
    End If
    
    ' Add a slash at the end of the path if needed.
    If Right(FolderPath, 1) <> "\" Then
        FolderPath = FolderPath & "\"
    End If

    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(FolderPath & "*.xls*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If
    
    Do While FilesInPath <> ""
        Set Wkb = Workbooks.Open(FolderPath & FilesInPath)
        For Each WS In Wkb.Worksheets
            Range("B:C").Copy Destination:=Worksheets("Sheet1").Range("B1")
        Next WS
        Wkb.Close False
        FilesInPath = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

 

[Micron]

After a quick glance, I see that you say you want to paste to SheetA, but you specifiy Sheet1 in code, so perhaps you have not referenced the correct sheet name.
I have only used the fd to return one selection so I may be off base here: you have multiselect true, but I don't see where you have dealt with the range of files that may have been selected. Don't you have to create a collection of paths (or an array) and have an outer loop for that with the sheets loop nested within? I would recommend using the filter property of the fd to limit the visible files to Excel types.

 

[smd71092]

After a quick glance, I see that you say you want to paste to SheetA, but you specifiy Sheet1 in code, so perhaps you have not referenced the correct sheet name.
I have only used the fd to return one selection so I may be off base here: you have multiselect true, but I don't see where you have dealt with the range of files that may have been selected. Don't you have to create a collection of paths (or an array) and have an outer loop for that with the sheets loop nested within? I would recommend using the filter property of the fd to limit the visible files to Excel types.

Sorry, I should have thought a little more clearly before posting my "example" sheet names, they are indeed referenced correctly in the code to their actual names in the workbook.

I am not sure what you mean with regard to the multiselect part of this. I think that part of the macro works fine, (cycling through all the different files was not a problem in the previous iteration which imported all the sheets with the addendum (2) or (3) etc but I want the sheets to be the same and for the columns to just be added to the end). Is this possible?

I believe it is the part within the Do While section that needs to be modified to do the following.
1) Go into the currently open file File1 (this is already taken care of by the macro up to the Do While section)
2) In File1:'Sheet 1', copy columns B&C (from B1:C1 down to the last row used in the columns)
3) Find 'Sheet 1' in cExcelFiles (the Excel file from which the macro was run).
4) Find the right-most column that is empty in Sheet1.
5) Paste the selection from File1:'Sheet 1' to cExcelFiles:'Sheet 1'.
6) Repeat steps 2-5 for Sheet1, Sheet2, Sheet3, etc. within File1.
7) Repeat steps 2-6 for File2, File3, etc.

I hope this is a little more clear! And again, I apologize but I am not a VBA expert but I am trying to learn! I do believe the macro is fine up until the Do While section (shown below), but am unsure how to make the Do While section perform steps 1-7 above.

    Do While FilesInPath <> ""
        Set Wkb = Workbooks.Open(FolderPath & FilesInPath)
        For Each WS In Wkb.Worksheets
            Range("B:C").Copy Destination:=Worksheets("Sheet1").Range("B1")
        Next WS
        Wkb.Close False
        FilesInPath = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True

Any help at all in this would be appreciated. Thanks so much again!!

 

[Micron]

I'm assuming you have created a collection before the code you've posted (which is possible because you have the file dialog multi-select as true, otherwise you could only pick one file) but you're not showing the part that makes the collection. Either that or it is a recordset. So what you seem to be doing is starting a loop to use each workbook chosen by the file dialog, then creating a For loop to reference each sheet, yet you are explicitly referencing Sheet1. Then you go to the next sheet in the same file and copy from Sheet1 again, then move to the next sheet and copy from Sheet1, and so on, but you are never pasting anywhere. Then you are setting FilesInPath to be the next file in the directory, but I'm not sure that is necessarily the next file in your collection. Then you repeat the above with the next file. Or am I missing something? You seem to have a pretty good handle on a lot of what you need to do, but you haven't figured out the pattern. I don't have ready-to-paste Excel code for copying/pasting (this is the Access part of the forum, after all), so here's what helps me with complicated nested loops like this. Grab a lined pad of paper, a pencil and eraser and map out the basics using some code keywords to help you keep it straight. Leave 2-3 blanks between lines so you can go back and insert stuff when you need to. This might not sound like a lot of practical help, but it works for me by letting me see the rough outline of what's needed. You seem to have a good handle on the logical approach with your outlined steps. In rough terms, you need an outer loop (1) to cycle through the selected workbooks, then an inner loop (2) to cycle through the sheets. To do this, either create the collection as before (For each) or assign the sheet count to an array (n = workbook.sheets.count or something like that) or if the file will always have the same sheet count, for n = 1 to 6. You will use this as an inner loop to cycle through the sheets where you copy and paste into the target file. You will have to OFFSET x columns to avoid over-writing in the target workbook. You could use a counter for this too, or have another loop to find the first cell in row 1 that ="". One of the difficulties with this is not doing something the FIRST time through, but for each time thereafter (such as the offset). Perhaps all of this will convince you that paper and pencil is not so dumb!
I'll have visitors for the next several days so I won't be able to spend much time on your issue until after that. Good luck.