将一个纸张范围附加到另一个纸张的末尾

我有一个问题，我没有昨晚。 下面的代码工作正常。 我有一个销售跟踪器的种类，我正在导入我们的名单，导出为Excel表格，而不是手动input小时。 我有那个部分sorting。 这是一本工作手册，每张表1周，共5页。 第一列中的名称，顶部的date。 我有代码，将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年的数据）。 它仍然是一个糟糕的设置。 你应该考虑改变你的devise。

 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