Question

我正在尝试创建一个集中式数据库，将多个工作簿中的相同选项卡（名为“Import”）导入到不同工作簿上的选项卡中。我是VBA的新用户，并从此处VBA Import multiple sheets into Workbook和此处https://danwagner.co/how-to-combine-data-from-multiple-sheets-into-a-single-sheet/修改其他人的代码。

当代码尝试从源工作表上的“导入”选项卡复制到目标工作表上的“数据”选项卡时，我遇到运行时错误91 :(参见下面的代码）：

rngSrcCountry.Copy Destination:=rngDstDatabase

有关如何改进我的代码以有效地将多个工作簿中的“导入”选项卡复制到单独工作簿上的“数据”选项卡中的任何建议？在此先感谢您的帮助！

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("Data")

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
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, 3)

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:=xlValues, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
    End With
Else
    lng = 1
End If
LastOccupiedRowNum = lng
End Function

Answer 1

您的代码在定义之前使用变量。以下行需要高于任何其他试图引用＆＃34; LngDstLastRow＆＃34;的代码，否则，它不知道lngDstLastRow是什么（它默认为什么）

lngDstLastRow = LastOccupiedRowNum（wksDstDatabase）

具体而言，上述行需要放在以下行之上：

设置rngDstDatabase = wksDstDatabase.Cells（lngDstLastRow + 1,1）

否则，您将未定义的变量提供给另一个变量，这意味着您的代码将转换如下：设置rngDstDatabase = wksDstDatabase.Cells（no + 1,1）。

VBA复制错误，将多个工作表导入中央工作簿数据库

1 个答案: