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

时间:2017-04-24 21:07:56

标签: excel vba excel-vba

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

1 个答案:

答案 0 :(得分:4)

试试这个,它设置两个范围的值相等,这将保留数据,但没有格式。它应该更快。

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