在Excel-Vba中復制多列

Question

嗨，我正在嘗試將多個列從一個工作簿復制到另一個工作簿，下面是我如何復制一個工作簿的代碼，並且由於我不想為所有列編寫相同的代碼而需要幫助使代碼更優化。 下面是代碼。

Sub Copymc()

Dim x As Workbook
Dim y As Workbook

Set x = Workbooks.Open("H:\testing\demo\test2.xlsx")
Set y = Workbooks.Open("H:\testing\demo\test1.xlsx")
Dim LastRow As Long
Dim NextRow As Long

' determine where the data ends on Column B Sheet1

x.Worksheets("Sheet1").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row

' copy the data from Column B in Sheet 1

Range("A2:A" & LastRow).Copy

' Determine where to add the new data in Column C Sheet 2

y.Worksheets("Sheet1").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Offset(1, 0).Select
NextRow = ActiveCell.Row

' paste the data to Column C Sheet 2

y.Worksheets("Sheet1").Range("A" & NextRow).Select

ActiveSheet.Paste

Application.CutCopyMode = False

Range("A1").Select

End Sub

我試圖將所有列都放在range語句中，但是發現的問題是如何粘貼？ 如何在不重復代碼的情況下針對多個列執行此操作？ 提前致謝。

Answer 1

假設您要復制廣告列：

Sub Copymc()

Dim x As Workbook
Dim y As Workbook

Set x = Workbooks.Open("H:\testing\demo\test2.xlsx")
Set y = Workbooks.Open("H:\testing\demo\test1.xlsx")
Dim LastRow As Long
Dim NextRow As Long

' determine where the data ends on Column B Sheet1

x.Worksheets("Sheet1").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row

' copy the data from Column B in Sheet 1

Range("A2:D" & LastRow).Copy y.worksheets("Sheet1").range("a65536").end(xlup).offset(1,0)

' Determine where to add the new data in Column C Sheet 2

'y.Worksheets("Sheet1").Activate
'Range("A65536").Select
'ActiveCell.End(xlUp).Offset(1, 0).Select
'NextRow = ActiveCell.Row

' paste the data to Column C Sheet 2

'y.Worksheets("Sheet1").Range("A" & NextRow).Select

'ActiveSheet.Paste

Application.CutCopyMode = False

Range("A1").Select

End Sub

Answer 2

我盡量避免復制和粘貼功能。 為了解決這個問題，我將遍歷該列中的所有值，並將它們按如下方式移動到您的其他工作簿中：

Sub test()

Dim x As Workbook
Dim y As Workbook

Set x = Workbooks.Open("H:\testing\demo\test2.xlsx")
Set y = Workbooks.Open("H:\testing\demo\test1.xlsx")
Dim LastRow As Long

LastRow = x.Sheets("Sheet1").Range("A65536").End(xlUp).Row

For i = 1 To LastRow
    CopyVal = x.Sheets("Sheet1").Range("A1").Offset(i, 0).Value
    CopyVal2 = x.Sheets("Sheet1").Range("A1").Offset(i, 1).Value
    CopyVal3 = x.Sheets("Sheet1").Range("A1").Offset(i, 2).Value
    CopyVal4 = x.Sheets("Sheet1").Range("A1").Offset(i, 3).Value

    y.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 3).Value = CopyVal4
    y.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 2).Value = CopyVal3
    y.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 1).Value = CopyVal2
    y.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = CopyVal

Next

End Sub