需要复制和粘贴每日宏，每次粘贴后向右移动到下一列

Question

大家好，我有一个小问题需要帮助。

我正在从工作表 1 的单元格区域 B1:B21 复制数据并粘贴到工作表 2 的单元格区域 C4:C25。

粘贴数据后，我想向右移动一列，

这是我目前的代码。

Private Sub CommandButton1_Click()

    Workbooks("COPY Service Tracker  August  2016.xlsm").Activate
    Sheets("Sheet2").Select
    ActiveSheet.Range("B1:B21").Select
    Selection.Copy
    Sheets("Queue Performance").Select
    ActiveSheet.Range("F4").Select


    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

         Application.CutCopyMode = False


End Sub

所以代码已经让我将正确的数据粘贴到我想要的位置。 现在，当我明天再次运行此宏时，复制的数据与昨天的数据不同，因为它也每天更新。 我想将这些新数据粘贴到昨天的下一列中，同时保留昨天的数据。

数据被输入到列中，标题为日期，所以我正在保存新的每日数据或每一天。 谢谢

Answer 1

您应该将Range 对象的.End(xlToLeft) 方法与.Cells(4, .Columns.Count) 结合使用，以获取第4 行中实际的最后一个非空单元格

然后避免使用Select/Selection 和Activate/ActiveXXX，它们都可能存在严重的速度问题，并且主要导致对您实际引用的工作簿/工作表的控制松散

所以你可以使用

Option Explicit

Private Sub CommandButton1_Click()
    Dim wb As Workbook

    Set wb = Workbooks("COPY Service Tracker  August  2016.xlsm")
    With wb.Worksheets("Queue Performance")
        .Cells(4, .Columns.Count).End(xlToLeft).Offset(, 1).Resize(, 21).value = wb.Worksheets("Sheet2").Range("B1:B21").value
    End With
End Sub

Answer 2

您可以使用.End(xlToRight) 查找最右侧的单元格，并使用.Offset(0,1) 引用下一列（该列将为空白）。例如：

Workbooks("COPY Service Tracker  August  2016.xlsm").Activate
Sheets("Sheet2").Select
ActiveSheet.Range("B1:B21").Select
Selection.Copy
Sheets("Queue Performance").Select

ActiveSheet.Range("A4").End(xlToRight).Offset(0,1).Select


Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

（假设从 A 列开始填满）

Answer 3

正如@Tim 在 cmets 中提到的，强烈建议避免使用.Select、.Copy 和.Paste。我还建议使用ThisWorkbook 而不是ActiveWorkbook，因为它有助于调试。通过设置范围，您可以使流程更快、更不容易出错：

Dim ws1, ws2 as Worksheet
Dim lCol as Long

Set ws1 = ThisWorkbook.Sheets("Queue Performance")
Set ws2 = Workbooks("COPY Service Tracker  August  2016.xlsm").Sheets("Sheet2")

lCol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
lRow = ws2.Cells(Rows.Count, "B").End(xlup).Row

ws1.Range(ws1.Cells(1, lCol), ws1.Cells(lRow, lCol)).Value = _
ws2.Range("B1:B" & lRow).Value

lCol 是要填充到 ThisWorkbook.Sheets("Queue Performance") 工作表中的最后一列，lRow 是要从 Workbooks("COPY Service Tracker August 2016.xlsm").Sheets("Sheet2") 工作表中复制的最后一行。