如何在同一工作表Excel VBA中复制列

我有一个程序需要复制相同的工作簿和工作表内的select列。 当前的代码导致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