CODEWITHSUNDEEP
excelvba
Chetan Chimate
Chetan Chimate

Reputation: 81

Copying multiple worksheets into VBA workbook itself

Below code works perfectly to copy data from an active worksheet of the SPECIFIED workbooks into a NEW unnamed workbook. It copies first row from first file and combines data from the other files excluding first (heading) row with it.

However, I am learning and I would like to know how I can combine the data in the same fashion into the macro workbook itself (and NOT in a new workbook). I intend to do some macro recording after the data is combined inside the same macro book.

Please help me how I can do this. I tried to move/copy the combined sheet from new workbook (one that is generated after running the below code) into the macro workbook and then close new workbook without saving it, but so far no success. Please help.

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

Upvotes: 3

Views: 503

Answers (1)

CBRF23
CBRF23

Reputation: 1518

Change your OutBook variable to reference ThisWorkbook, and change OutSheet to a sheet within this workbook. 

'set up the output workbook
Set OutBook = ThisWorkbook `Workbooks.Add

You're probably going to want to add a new sheet:

Set OutSheet = OutBook.Sheets.Add
OutSheet.Name = "CombineDataFilesOutput"

If you do this often, you may want to give the sheet a unique ID so you can add multiples without worrying about duplicate sheet names. I usually use some format of Now() to create a unique identifer:

OutSheet.Name = Format(Now(),"YYYYMMDDhhmmss")

I also noticed your comment on the files selected limit appears to mis-inform the user. You're telling them "please pick more than 2000 files" but should be saying "please pick no more than 2000 files" or even better "please pick less than 2000 files". 

'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 less than " &     MaxNumberFiles & ". Exiting sub...")
Exit Sub
End If

Upvotes: 0

Related Questions