Ошибка копирования VBA, импорт нескольких рабочих листов в центральную базу данных рабочих книг - PullRequest
Новая
       33

Ошибка копирования VBA, импорт нескольких рабочих листов в центральную базу данных рабочих книг

0 голосов
/ 01 июня 2018

Я пытаюсь создать централизованную базу данных, которая импортирует одну и ту же вкладку (с именем «Импорт») из нескольких рабочих книг в одну вкладку другой рабочей книги.Я новичок в VBA, и здесь я изменяю чужой код VBA Импорт нескольких листов в рабочую книгу и здесь 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

1 Ответ

0 голосов
/ 01 июня 2018

Ваш код использует переменные до того, как они определены.Нижняя строка должна быть выше любого другого кода, который пытается сослаться на «LngDstLastRow», в противном случае он не будет знать, что такое lngDstLastRow (по умолчанию он ничто)

lngDstLastRow = LastOccupiedRowNum (wksDstDatabase)

В частности, указанную выше строку необходимо поместить над следующей строкой:

Set rngDstDatabase = wksDstDatabase.Cells (lngDstLastRow + 1, 1)

В противном случае вы передаете неопределенную переменную в другую переменную, что означает, что ваш код будет преобразован следующим образом: Установите rngDstDatabase = wksDstDatabase.Cells (none + 1,1).

...