Import Multiple Closed Worksheets to Central Worksheet

Question

I'm attempting to create a centralized database that imports the same tab (named "Import") from multiple workbooks into a tab on a different workbook.

I am new to VBA, and modifying code from VBA Import multiple sheets into Workbook and https://danwagner.co/how-to-combine-data-from-multiple-sheets-into-a-single-sheet/.

Only the data from the open file is imported into the database worksheet. I would like all the selected files' "Import" tabs to be brought in. Additionally, I'd like to not open any of the source files.

Sub InsertDatabase()

Dim FileNames As Variant 'Group of files to be looped through
Dim FileName As Variant 'Country of focus (file open)
Dim ActiveCountryWB As Workbook 'Active workbook of country
Dim wksSrcCountry As Worksheet 'Import worksheet in country
Dim wksDstDatabase As Worksheet 'Data worksheet in database
Dim rngSrcCountry As Range 'Range of data in import worksheet
Dim rngDstDatabase As Range 'Range of data in data worksheet in database
Dim lngSrcLastRow As Long
Dim lngDstLastRow As Long

'Set destination reference
Set wksDstDatabase = ThisWorkbook.Worksheets(1)

MsgBox "In the following browser, please choose the Excel file(s) you want to copy data from"
FileNames = Application.GetOpenFilename _
(Title:="Please choose the files you want to copy data FROM", _
FileFilter:="All Files (*.*),*.*", _
MultiSelect:=True)

If VarType(CountriesGroup) = vbBoolean Then
    If Not CountriesGroup Then Exit Sub
End If

'Set initial destination range
lngDstLastRow = LastOccupiedRowNum(wksDstDatabase)
Set rngDstDatabase = wksDstDatabase.Cells(lngDstLastRow + 1, 1)

'Loop over all files selected by user, and import the desired "Import" sheet
For Each FileName In FileNames

    'Set country workbook references
    Set ActiveCountryWB = Workbooks.Open(FileName)
    Set wksSrcCountry = ActiveCountryWB.Sheets("Import")

    'Identify last occupied row on import sheet
    lngSrcLastRow = LastOccupiedRowNum(wksSrcCountry)

    'Store source data
    With wksSrcCountry
        Set rngSrcCountry = .Range(.Cells(1, 1), .Cells(lngSrcLastRow, 20))
        rngSrcCountry.Copy Destination:=rngDstDatabase
    End With

    'Redefine destination range now that new data has been added
    lngDstLastRow = LastOccupiedRowNum(wksDstDatabase)
    Set rngDstDatabase = wksDstDatabase.Cells(lngDstLawRow + 1, 1)

Next FileName

End Sub

Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long

    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet

        lng = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng
End Function

Answer 1

The code you pulled online is honestly poorly put together. You do not need a function to determine the last row (as seen below). I would try this instead (clear your code out of the excel). The macro should follow the below steps:

1) Prompt user to select import files
2) Copy the data form "Import" sheet from Col A - T (down to last row) into your Database
3) Close the Import Book
4) Loop steps 2 & 3 until all Import books are covered

-Paste this code in a module
-Create a new sheet called "Data" (make sure it has headers or this will error out)
-If your Import sheets have headers you need to change the copy range from A1 to A2 (otherwise you will keep importing headers in the middle of your data)

Sub Database()

Dim CurrentBook As Workbook 'Import books
Dim ImportFiles As FileDialog
Dim FileCount As Long 'Count of Import books selected
Dim Database As Worksheet
    Set Database = ThisWorkbook.Sheets("Data")

'Open File Picker
Set ImportFiles = Application.FileDialog(msoFileDialogOpen)
With ImportFiles
    .AllowMultiSelect = True
    .Title = "Pick import files"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
End With

'Stop Alerts/Screen Updating
Application.DisplayAlerts = False
Application.DisplayAlerts = False

'Move Data from ImportBook(s) to Database
For FileCount = 1 To ImportFiles.SelectedItems.Count
    Set CurrentBook = Workbooks.Open(ImportFiles.SelectedItems(FileCount))

    'Determine Last Row on Import Book
    Dim ImportLRow As Long
    ImportLRow = CurrentBook.Sheets("Import").Range("A" & CurrentBook.Sheets("Import").Rows.Count).End(xlUp).Row

    'Determine Last Row on Database Book
    Dim DatabaseLRow As Long
    DatabaseLRow = Database.Range("A" & Database.Rows.Count).End(xlUp).Offset(1).Row

    'Copy Range
    Dim CopyRange As Range
    Set CopyRange = CurrentBook.Sheets("Import").Range("A1:T" & ImportLRow) 'If the sheets have headers, change this from A1 to A2
        CopyRange.Copy

    'Paste Range
    Database.Range("A" & DatabaseLRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone

    'Close Import Book (Do not save)
    CurrentBook.Close False

Next FileIdx

'Enable Alerts/Screen Updating
Application.DisplayAlerts = True
Application.DisplayAlerts = True

End Sub