もう1枚の範囲を最後に貼る

Question

私は昨晩は問題なかった。以下のコードはうまくいきました。私は一種のセールストラッカーを持っています。私は、時間を手動で入力するのではなくExcelシートとしてエクスポートされたロスターをインポートする作業をしています。私はその部分をソートしました。これは1枚のワークブックで、1枚につき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