【问题标题】:How to copy columns within same worksheet Excel VBA如何在同一个工作表Excel VBA中复制列
【发布时间】:2017-04-25 05:37:46
【问题描述】:

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

【问题讨论】:

  • 最后去掉.Value。您只想复制到一个范围,而不是值。但是,如果你只需要值而不是格式化/等,你可以做Range([Destination Range]).Value = Range([copy range]).Value,即wb1.Worksheets(1).Columns("H").Value = wb1.Worksheets(1).Columns("G").Value。另外,你需要使用整个列吗?
  • 啊,我补充说,因为客户想要一个仅粘贴值的选项,我认为这就是你可以做到的方式
  • 我确实需要整列
  • 现在很少需要整列,即 1048576 个单元格,其中大部分是空的。
  • @DylanF - 我们可以用一两行简单的代码来处理。如果行随时间变化,您只需要为每一列获取lastRow。但就目前而言,如果它有效,它就有效!

标签: vba excel


【解决方案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

【讨论】:

  • 还有 12 分钟 - 在这里得到一个“接受的答案”,你就成功了!
  • 谢谢!这行得通,就像你说的,它花了一点时间,但它满足了客户的需求
  • 恭喜布鲁斯!!
  • @YowE3K 和大家 - Thanks! :D
猜你喜欢
  • 1970-01-01
  • 2016-11-19
  • 1970-01-01
  • 2019-05-02
  • 2013-10-26
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2014-01-28
相关资源
最近更新 更多