Hello everyone!
First time poster here, so feel free to give me hell if I'm doing something wrong. Anywho, the question!
I'm looking for a Macro that will:
A - Grant selection of multiple files (Done)
B - Automatically open and close selected files(Done)
C - Copy the first sheet (Kinda done?)
C2.0 (if doable) - Copy all sheets (Nope)
D - Paste that sheet back into a master file (file that is executing the macro), on a newly generated sheet of it's own.
D2.0 (if doable) - Paste onto a new sheet and name the sheet after the file (or cell A1 of that file, whichever easier)
E - Prompt when finished (Done)
The code I have attached below has many of the features I'm looking for, however, it places the contents in the master on the first sheet, not separate sheets. All I really ask is that C and D be resolved, the optional ones are just kind of a "Oh I've done that before, and I happen to have it right here" thing.
My VBA experience is rather rudimentary, and I've only done some basic projects involving Excel/Word crossovers. So sadly this is a bit out of my skill level.
Thanks for your time!
-L
First time poster here, so feel free to give me hell if I'm doing something wrong. Anywho, the question!
I'm looking for a Macro that will:
A - Grant selection of multiple files (Done)
B - Automatically open and close selected files(Done)
C - Copy the first sheet (Kinda done?)
C2.0 (if doable) - Copy all sheets (Nope)
D - Paste that sheet back into a master file (file that is executing the macro), on a newly generated sheet of it's own.
D2.0 (if doable) - Paste onto a new sheet and name the sheet after the file (or cell A1 of that file, whichever easier)
E - Prompt when finished (Done)
The code I have attached below has many of the features I'm looking for, however, it places the contents in the master on the first sheet, not separate sheets. All I really ask is that C and D be resolved, the optional ones are just kind of a "Oh I've done that before, and I happen to have it right here" thing.
My VBA experience is rather rudimentary, and I've only done some basic projects involving Excel/Word crossovers. So sadly this is a bit out of my skill level.
Thanks for your time!
-L
Code:
Option Explicit
Sub CombineDataFiles()
Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
LastDataRow As Long, LastDataCol As Long, _
HeaderRow As Long, LastOutRow As Long
Dim DataRng As Range, OutRng As Range
'initialize constants
MaxNumberFiles = 2001
HeaderRow = 1 'assume headers are always in row 1
LastOutRow = 1
'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
'error trap - don't allow user to pick more than 2000 files
If TargetFiles.SelectedItems.Count > MaxNumberFiles Then
MsgBox ("Too many files selected, please pick more than " & MaxNumberFiles & ". Exiting sub...")
Exit Sub
End If
'set up the output workbook
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)
'loop through all files
For FileIdx = 1 To TargetFiles.SelectedItems.Count
'open the file and assign the workbook/worksheet
Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
Set DataSheet = DataBook.ActiveSheet
'identify row/column boundaries
LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
'if this is the first go-round, include the header
If FileIdx = 1 Then
Set DataRng = Range(DataSheet.Cells(HeaderRow, 1), DataSheet.Cells(LastDataRow, LastDataCol))
Set OutRng = Range(OutSheet.Cells(HeaderRow, 1), OutSheet.Cells(LastDataRow, LastDataCol))
'if this is NOT the first go-round, then skip the header
Else
Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 1), DataSheet.Cells(LastDataRow, LastDataCol))
Set OutRng = Range(OutSheet.Cells(LastOutRow + 1, 1), OutSheet.Cells(LastOutRow + 1 + LastDataRow, LastDataCol))
End If
'copy the data to the outbook
DataRng.Copy OutRng
'close the data book without saving
DataBook.Close False
'update the last outbook row
LastOutRow = OutSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Next FileIdx
'let the user know we're done!
MsgBox ("Combined " & TargetFiles.SelectedItems.Count & " files!")
End Sub