Copy-Paste Несколько столбцов в VBA

Question

Я пытаюсь скопировать выбранные столбцы с листа одной книги на лист другой книги. Есть 10 столбцов, но мне нужно скопировать всего 4 и вставить их в другой. Вот код

Sub CopyCoverage() 

Dim x As Workbook 
Dim y As Workbook 
Dim rng As Range 
Dim LastRow As Long 
Dim NextRow As Long 

Set x = Workbooks.Open("C:\testing\abc.xlsm") 
Set y = ThisWorkbook 

x.Worksheets("Sheet1").Activate // Here I need to select just 4 columns but it selects everything 
Range("A65536").Select 
ActiveCell.End(xlUp).Select 
LastRow = ActiveCell.Row 

Range("A2:A" & LastRow).Copy y.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 0) 
Range("B2:B" & LastRow).Copy y.Worksheets("Sheet1").Range("e65536").End(xlUp).Offset(1, 0) 
Range("H1:H" & LastRow).Copy y.Worksheets("Sheet1").Range("g65536").End(xlUp).Offset(1, 0) 
Range("I1:I" & LastRow).Copy y.Worksheets("Sheet1").Range("i65536").End(xlUp).Offset(1, 0) 
Application.CutCopyMode = False 

End Sub 

Как я могу написать это в общем синтаксисе? Благодарю.

Answer 1

Почему бы вам не попробовать сначала использовать спецификацию лучшего диапазона? Вы можете избавиться от своего кода, который находит LastRow.

Application.Intersect(Range(Cells(2, 1), Cells(ActiveWorksheet.Rows.Count, 1)), ActiveSheet.UsedRange).Copy 

Приведенный выше код выберет все данные в столбце A, будет ли он смежным или нет. Измените вторую координату в функции Cells(), чтобы изменить столбцы. Таким образом, ячейки (1,1) = A1, ячейки (2, 1) = A2, ячейки (1, 2) = B1 и т. Д.

Затем вам необходимо активировать эту книгу в отдельной строке. Что-то вроде:

y.Activate 
y.Sheets("Sheet1").Activate 
Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1,0).Select 
ActiveSheet.Paste 

Затем вернитесь и сделать остальные три колонки:

x.Activate 
Application.Intersect(Range(Cells(2, 2), Cells(ActiveSheet.Rows.Count, 2)), ActiveSheet.UsedRange).Copy 
y.Activate 
y.Sheets("Sheet1").Activate 
Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Offset(1,0).Select 
ActiveSheet.Paste 

И так далее, пока вы не будете счастливы. Надеюсь, это поможет! Matt через ExcelArchitect.com

Answer 2

пытаются не использовать .select и ActiveCell

Sub CopyCoverage() 

Dim x As Worksheet, y As Worksheet, LastRow& 

Workbooks.Open ("C:\testing\abc.xlsm") 

Set x = Workbooks("abc.xlsm").Worksheets("Sheet1") 
Set y = ThisWorkbook.Worksheets("Sheet1") 

LastRow = x.Cells.SpecialCells(xlCellTypeLastCell).Row 

x.Range("A2:A" & LastRow).Copy y.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 
x.Range("B2:B" & LastRow).Copy y.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0) 
x.Range("H1:H" & LastRow).Copy y.Cells(Rows.Count, "H").End(xlUp).Offset(1, 0) 
x.Range("I1:I" & LastRow).Copy y.Cells(Rows.Count, "I").End(xlUp).Offset(1, 0) 

Application.CutCopyMode = False 

End Sub 

Кроме того, если таблица является динамическим (столбцы могут быть не в месте, где они должны быть, например, данные в столбцах " B "был перенесен в столбец« C »), тогда вы можете использовать метод« .find »для получения требуемых столбцов (поиск в заголовке), который требуется скопировать