问将多个已关闭的工作表导入到中心工作表

EN

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