Приведенный ниже код предназначен для копирования данных из одного Workbook
, вставки его внизу другого, а затем удаления дубликатов из файла назначения.
Изначально я разработал код в модуле ThisWorkbook
, но когда я добавил кнопку в Sheet1 для запуска макроса, он вылетает при попытке назначить данные из исходного файла в массив newData
.
Это похоже на проблему, связанную с поведением Excel, с которой я менее знаком.
Редактировать: я также экспериментировал с вырезанием массива и простым использованием метода «Transfer», в котором Cells.Value
в конечном файле присваивался Cells.Value
исходного файла. Он прекрасно работает для перемещения данных, но тогда .removeDuplicates
просто ничего не делает. Это не происходит из-за ошибки, но просто не удаляет дубликаты.
Спасибо !!!
For i = 0 To 16
colArray(i) = i + 1
Next i
location = "R:\dummyLocation"
destLastRow = Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Workbooks.Open (location & "SOURCE_FILE.xlsx")
Workbooks("SOURCE_FILE.xlsx").Worksheets(1).Activate
sourceLastRow = Workbooks("SOURCE_FILE.xlsx").Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
newData = Workbooks("SOURCE_FILE.xlsx").Worksheets(1).Range(Cells(3, 1), Cells(sourceLastRow, 17))
Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Activate
Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Range("A:Q").NumberFormat = "@"
Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Range(Cells(destLastRow + 1, 1), Cells(destLastRow + sourceLastRow - 2, 17)) = newData
destLastRow = Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Set cbuRange = Range(Cells(1, 1), Cells(destLastRow, 17))
cbuRange.RemoveDuplicates Columns:=(colArray), Header:=xlYes
Workbooks("DESTINATION_FILE.xlsx").Save
Workbooks("DESTINATION_FILE.xlsx").Close
Workbooks("SOURCE_FILE.xlsx").Close