如何複製同一工作表中的列Excel VBA

Question

我有一個程序需要複製同一工作簿和工作表中的選擇列。 當前的代碼導致Excel崩潰，所以我不確定它是否工作。

有沒有更好的方法來將同一工作表中的列複製到同一個工作簿中？

代碼：

Sub Macro1() 

Dim wb1 As Workbook 

'Set it to be the file location, name, and file extension of the Working File 
Set wb1 = Workbooks.Open("Z:\XXX\Working File.xlsx") 

MsgBox "Copying Fields within Working File" 

wb1.Worksheets(1).Columns("G").Copy wb1.Worksheets(1).Columns("H").Value 
wb1.Worksheets(1).Columns("J").Copy wb1.Worksheets(1).Columns("O").Value 
wb1.Worksheets(1).Columns("K").Copy wb1.Worksheets(1).Columns("N").Value 
wb1.Worksheets(1).Columns("M").Copy wb1.Worksheets(1).Columns("P").Value 

wb1.Close SaveChanges:=True 

End Sub 

Answer 1

試試這個，它設置了兩個範圍值相等，這將保持數據，但沒有格式。它應該更快。

Sub Macro1() 
Dim wb1 As Workbook 
'Set it to be the file location, name, and file extension of the Working File 
Set wb1 = Workbooks.Open("Z:\XXX\Working File.xlsx") 

MsgBox "Copying Fields within Working File" 

With wb1.Worksheets(1) 
    .Columns("H").Value = .Columns("G").Value 
    .Columns("O").Value = .Columns("J").Value 
    .Columns("N").Value = .Columns("K").Value 
    .Columns("P").Value = .Columns("M").Value 
End With 

wb1.Close SaveChanges:=True 

End Sub 

注意您使用的是整列，所以它可能會中止，或需要較長的時間。如果你願意，你可以直接得到每列的最後一行，並用它來縮短被複制的範圍。

編輯：如上所述，使用更小的範圍可能會更好。這有點更詳細，但你應該能夠遵循它在做什麼：

Sub Macro1() 
Dim wb1 As Workbook 
Dim lastRow As Long 
'Set it to be the file location, name, and file extension of the Working File 
Set wb1 = ActiveWorkbook 

MsgBox "Copying Fields within Working File" 

With wb1.Worksheets(1) 
    lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row 
    .Range("H1:H" & lastRow).Value = .Range("G1:G" & lastRow).Value 

    lastRow = .Cells(.Rows.Count, "J").End(xlUp).Row 
    .Range("O1:O" & lastRow).Value = .Range("J1:J" & lastRow).Value 

    lastRow = .Cells(.Rows.Count, "K").End(xlUp).Row 
    .Range("N1:N" & lastRow).Value = .Range("K1:K" & lastRow).Value 

    lastRow = .Cells(.Rows.Count, "M").End(xlUp).Row 
    .Range("P1:P" & lastRow).Value = .Range("M1:M" & lastRow).Value 
End With 

wb1.Close SaveChanges:=True 

End Sub