每次启动宏时如何复制列并将值粘贴到新列

Question

我有一个计算 Z 列差异的电子表格。在月底，我想将这些值复制并粘贴到同一电子表格的另一列中，以跟踪每月的差异。

我有一个宏要从 Z 列复制到 BK 列。

我希望每次运行宏时都从 Z 列复制值并使用以下时间表将其粘贴到新列中：

• 第 1 个月 = 值应粘贴到 BK 列中
• 第 2 个月 = 值应粘贴到 BL 列中
• 第 3 个月 = 值应粘贴到 BM 列中
• 第 4 个月 = 值应粘贴到 BN 列中
• 第 5 个月 = 值应粘贴到 BO 列中
• 第 6 个月 = 值应粘贴到 BP 列中
• 第 7 个月 = 值应粘贴到 BQ 列中
• 第 8 个月 = 值应粘贴到 BR 列中
• 第 9 个月 = 值应粘贴到 BS 列中
• 第 10 个月 = 值应粘贴到 BT 列中
• 第 11 个月 = 值应粘贴到 BU 列中
• 第 12 个月 = 值应粘贴到 BV 列中

第 12 次迭代后，我希望将 Z 列中的值复制到 BK 列（起点）。我相信这可以使用循环来完成？

我很难想出循环逻辑/编码。

Sub copyCurrentToPrevious()

    Dim ans As String

    On Error Resume Next

    Application.ScreenUpdating = False

    Sheets("Direct Materials").Activate

    ans = MsgBox("Are you sure you want to copy Previous Month Variance to YTD Variance Tracking?  This action can not be undone." & vbNewLine _
      & vbNewLine & "Select Yes to proceed with the copy/paste operation or Select No to cancel.", vbYesNo + vbExclamation, "Product Costing")

    If ans = vbNo Then Exit Sub

    Range("Z9:Z220").Copy
    Range("BK9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

    Range("Z226:Z306").Copy
    Range("BK226").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

    Range("Z311:Z471").Copy
    Range("BK311").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

    Range("Z476:Z524").Copy
    Range("BK476").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

    Application.CutCopyMode = False

    Range("A1").Select

    MsgBox "Copy / paste operation is complete.  Select OK to continue.", vbOKOnly + vbInformation, "Product Costing"

    Application.ScreenUpdating = True

End Sub

Answer 1

这是您的代码重构，添加所需的偏移量，并解决了许多其他问题：

• 为ans 使用正确的数据类型
• 不要使用Resume Next。这就是说我不在乎我是否有错误，不管怎样，继续。谁知道接下来会发生什么
• 不要使用Activate 或Select（除非您有特殊需要）。请改用Workbook、Worksheet 和Range 对象。请注意，Worksheets("Direct Materials") 隐含地说 Activeworkbook.Worksheets("Direct Materials")
• 你实际上不需要Copy/Paste。请改用.Value 返回的Variant Array。这将更快，并且不易受到其他应用程序使用剪贴板的干扰。这也是一个好习惯，因为它在各种方面都很有用。

---

Sub copyCurrentToPrevious()
    Dim ans As VbMsgBoxResult
    Dim rng As Range

    On Error GoTo EH

    ans = MsgBox("Are you sure you want to copy Previous Month Variance to YTD Variance Tracking?  This action can not be undone." & vbNewLine _
        & vbNewLine & "Select Yes to proceed with the copy/paste operation or Select No to cancel.", vbYesNo + vbExclamation, "Product Costing")

    If ans = vbNo Then Exit Sub
    Application.ScreenUpdating = False

    With Worksheets("Direct Materials")
        Set rng = .Range("Z9:Z220")
        rng.Offset(0, Month(Now()) + 36).Value = rng.Value

        Set rng = .Range("Z226:Z306")
        rng.Offset(0, Month(Now()) + 36).Value = rng.Value

        Set rng = .Range("Z311:Z471")
        rng.Offset(0, Month(Now()) + 36).Value = rng.Value

        Set rng = .Range("Z476:Z524")
        rng.Offset(0, Month(Now()) + 36).Value = rng.Value
    End With

    MsgBox "Copy / paste operation is complete.  Select OK to continue.", vbOKOnly + vbInformation, "Product Costing"

    Application.ScreenUpdating = True
Exit Sub
EH:
    MsgBox "Something went horribly wrong!"
End Sub