Question

我有一个问题，我昨晚没有。下面的代码工作正常。我有一个销售跟踪器，我正在努力导入我们的名单，导出为Excel表格，而不是手动输入小时。我把那部分分类了。这是一本工作簿，每张1周，总共5张。第一列中的名称，顶部的日期。我有代码将5张纸张导入跟踪器，从第2-5页删除第一列（名称列），以下代码追加到第1周（或第1页）的最后一列，然后合并后删除表2-5。工作没问题。现在它到了中途，并且a）坐在那里旋转它的轮子，或者b）崩溃Excel。它似乎陷入了下面的Sub。如果我发表评论，它运行正常。

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

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

2 个答案: