Ответ 1
Вы можете изменить
Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow)
к
Range("B3:B65536").Copy
Sheets("DB").Range("B" & lastrow).PasteSpecial xlPasteValues
Кстати, если у вас есть xls файл (excel 2003), вы получите ошибку, если ваш lastrow
будет больше 3.
Попробуйте использовать этот код:
Sub Get_Data()
Dim lastrowDB As Long, lastrow As Long
Dim arr1, arr2, i As Integer
With Sheets("DB")
lastrowDB = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
arr1 = Array("B", "C", "D", "E", "F", "AH", "AI", "AJ", "J", "P", "AF")
arr2 = Array("B", "A", "C", "P", "D", "E", "G", "F", "H", "I", "J")
For i = LBound(arr1) To UBound(arr1)
With Sheets("Sheet1")
lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
End With
Next
Application.CutCopyMode = False
End Sub
Примечание. выше код определяет последнюю непустую строку на DB
в столбце A
(переменная lastrowDB
). Если вам нужно найти последнюю точку для каждого столбца назначения в листе DB
, используйте следующую модификацию:
For i = LBound(arr1) To UBound(arr1)
With Sheets("DB")
lastrowDB = .Cells(.Rows.Count, arr2(i)).End(xlUp).Row + 1
End With
' NEXT CODE
Next
Вместо этого вы можете использовать следующий подход Copy/PasteSpecial
. Заменить
.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
с
Sheets("DB").Range(arr2(i) & lastrowDB).Resize(lastrow - 2).Value = _
.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Value