将一个工作表范围附加到另一个工作表范围的末尾

Question

我有一个昨晚没有的问题。下面的代码运行良好。我有一个销售跟踪器，我正在导入我们的花名册，导出为Excel表格，而不是手动输入小时数。我已经把那部分整理好了。这是一个工作簿，每页1周，总共5张。第一列中的姓名，顶部的日期。我的代码将5个工作表导入到跟踪器中，从工作表2-5中删除第一列(名称列)，并将以下代码附加到第1周的最后一列(或工作表1)，然后在合并后删除工作表2-5。工作起来没问题。现在它到了一半，a)坐在那里旋转它的轮子，或者b)崩溃Excel。它似乎卡在下面的潜水艇上了。如果我注释掉它，它运行得很好。

Sub MergeSheets()
    Dim NextCol As Long
    NextCol = Sheets("1").Cells(1, Columns.Count).End(xlToLeft).Column + 1
    ThisWorkbook.Sheets("2").Range("A1:XX100").Copy Sheets("1").Cells(1, NextCol)

    NextCol = Sheets("1").Cells(1, Columns.Count).End(xlToLeft).Column + 1
    ThisWorkbook.Sheets("3").Range("A1:XX100").Copy Sheets("1").Cells(1, NextCol)

    NextCol = Sheets("1").Cells(1, Columns.Count).End(xlToLeft).Column + 1
    ThisWorkbook.Sheets("4").Range("A1:XX100").Copy Sheets("1").Cells(1, NextCol)

    NextCol = Sheets("1").Cells(1, Columns.Count).End(xlToLeft).Column + 1
    ThisWorkbook.Sheets("5").Range("A1:XX100").Copy Sheets("1").Cells(1, NextCol)
End Sub

Answer 1

这看起来像是一个小错误，但它很重要--您没有引用Column的父级，而是它采用了活动工作表。

试着这样做：

Sub MergeSheets()

    Dim NextCol As Long

    With Sheets("1")
        NextCol = Sheets("1").Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        Sheets("2").Range("A1:XX100").Copy .Cells(1, NextCol)

        NextCol = Sheets("1").Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        Sheets("3").Range("A1:XX100").Copy .Cells(1, NextCol)

        NextCol = Sheets("1").Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        Sheets("4").Range("A1:XX100").Copy .Cells(1, NextCol)

        NextCol = Sheets("1").Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        Sheets("5").Range("A1:XX100").Copy .Cells(1, NextCol)
    End With
End Sub

Answer 2

很难说问题到底出在哪里。您的设置不正确。每次运行代码时，您都会追加648列*4。当前Excel格式中只有16384列。在运行你的代码25次之后，你的空间就会用完。即使你可能只会运行它13次(相当于1年的数据)，它仍然是一个糟糕的设置。你应该考虑改变你的设计。

Sub MergeSheets()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ws As Worksheet
    Dim NextCol As Long
    With ThisWorkbook.Worksheets("1")
        For Each ws In Sheets(Array("2", "3", "4", "5"))
            ws.Range("A1:XX100").Copy .Cells(1, .Columns.count).End(xlToLeft).Offset(0, 1)
        Next
    End With

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub