現在アクティブなブックのシートに、複数ブックのデータを挿入貼り付けする

今回は、マクロを使い始めた人がまず最初にやってみそうなことを、やってみようかと思います。

やりたいことは単純に下記のようなこと。

a.xlsx、b.xlsx、c.xlsx、d.xlsx、･･････z.xlsxのように行数が不定な複数ブックがあり、

これらのデータを、a.xlsxのデータ群の下側に挿入貼り付けをしていくというものです。（貼り付けされる側のブックは、b.xlsx、c.xlsx･･････であってもよい）

今回のマクロの中身をざっくりと説明すると、Application.GetOpenFilenameというメソッドで、ファイル選択のためのダイアログボックスを開き、ブックを選択します（ブックは複数選択可能です）。
ここでは、a.xlsxにペーストするので、a.xlsxを除いた、b.xlsx～z.xlsxを選択。（a.xlsxは開いた状態にしておく）

ここで選択されたブックのブック名（パスを含んだFullName）が配列に格納されるため、配列の内容をFor Each　～Nextで順次読み取り

• 取得したブック名を用いてブックを開く
• ブックを開いた時にアクティブなシートのデータをコピー
• 貼り付けされる側のブックのデータ群の１行下にインサート
• 開いたブックを変更せずに閉じる

というループ処理を行います。

コピーを開始するための始点となる行はユーザーが指定する必要がありますが、終点となる行はプログラムが自動判別します。
なので、行数は不定であっても、見出しの位置や内容、列の数などは同様なデータの連結を想定しています。（そもそも、様式の異なる資料を連結しても意味ないですし。）

その他は、不具合防止のための処理などがずらずらと並んでいます。 

Sub 現在アクティブなブックに複数ブックのデータを挿入貼り付け()
    '現在アクティブなブックのデータ群の１行下に、選択されたブックのデータを、順番に挿入貼り付けしていきます。
    '対象となるのは、*.xlsx、*.xlsm、、*.csv等のエクセルで扱うことのできるファイルです。
    'ペーストされるブック（現在アクティブなブック）以外は閉じた状態で実行して下さい。
    'コピーするブックは、ペーストされる側のブックと同じ様式であることを想定しています。
    Dim awn As String
    Dim Bcdrive As String
    Dim Bcdir As String
    Dim lwfn As Variant
    Dim ctm As Integer
    Dim yr As Range
    Dim nod As Variant
    Dim anod As Long
    Dim y As Long
    Dim x As Integer
    Dim myWb As Variant
    Dim i As Integer
    Dim cts1 As Integer
    Dim lwn As String
    Dim myLis As ListObject
    Dim lye As Long
    Dim aye As Long
    Dim cts2 As Integer
    Dim ct As Integer
    
    awn = ActiveWorkbook.Name
        If Not awn Like "*.*" Then
            MsgBox "新規ブック上では実行できません。"
            Exit Sub
        End If
        
    Bcdrive = Left(CurDir, InStr(CurDir, ":") - 1)  '現在のカレントドライブを記憶
    Bcdir = CurDir  '現在のカレントディレクトリを記憶
    
    ChDrive Left(ActiveWorkbook.Path, InStr(ActiveWorkbook.Path, ":") - 1)    'カレントドライブを一時的に変更
    ChDir ActiveWorkbook.Path 'カレントディレクトリを一時的に変更
    
    lwfn = Application.GetOpenFilename(Title:="コピーするブックを選択（複数選択可）", MultiSelect:=True)
        If TypeName(lwfn) = "Boolean" Then  'キャンセルを押された場合の処理
            ChDrive Bcdrive
            ChDir Bcdir
            Exit Sub
        End If
        
    ctm = UBound(lwfn)

retry1:

    On Error Resume Next
    
    Set yr = Nothing 'retryした時のためのリセット

    Set yr = Application.InputBox(Prompt:="コピーの始点となる行のセルを選択し、OKして下さい。" & vbCrLf & "（見出しの1行下を推奨）", Type:=8)
        If yr Is Nothing Then    'キャンセルを押された場合の処理
            ChDrive Bcdrive
            ChDir Bcdir
            Exit Sub
        ElseIf yr.Resize(1, 1).Value = "" Then  '複数範囲を選択された場合も想定して、Resizeを適用する
            MsgBox "空白以外のセルを選択してください。"
            GoTo retry1
        End If

    On Error GoTo 0
    
retry2:
    
    nod = Application.InputBox(Prompt:="行×列 に含まれる、最大データ数を指定して下さい。" & vbCrLf & _
    "・コピーするブックがこの値を超えた場合、処理をスキップします。" & vbCrLf & _
    "・フリーズ防止策です。環境に応じて増減して下さい。", Default:="10000", Type:=1)
        If TypeName(nod) = "Boolean" Then  'キャンセルを押された場合の処理
            ChDrive Bcdrive
            ChDir Bcdir
            Exit Sub
        Else
            anod = WorksheetFunction.CountIf(Range("A1:XFD1048576"), "<>")
            If anod > nod Then
                MsgBox "ペーストされる側のブックに" & Format(nod, "#,###") & "を超える、" & Format(anod, "#,###") & "データが存在します。" _
                & vbCrLf & vbCrLf & "フリーズを避けるために、軽量なブック上で実行することを推奨します。" & vbCrLf & _
                "コピーする側のブックではさらにメモリを必要としますので、必要に応じ、" & vbCrLf & "最大データ数を増減して下さい。"
                GoTo retry2
            End If
        End If
    
    Application.ScreenUpdating = False  '画面表示の更新をオフにする
    
    y = yr.Row  'yrから行を取得
    x = yr.Column   'yrから列を取得
    
    If Not ActiveSheet.AutoFilter Is Nothing Then   '念のための処理１
        Cells(y, x).AutoFilter
    End If

    For Each myWb In lwfn
        For i = 1 To Workbooks.Count
            If Workbooks(i).FullName = myWb Then    '既に開いているブックは処理をスキップ
                If Not myWb Like "*" & awn Then 'ペーストされるブックはスキップにカウントしない
                    cts1 = cts1 + 1
                End If
                GoTo skip
            End If
        Next i
        
        Workbooks.Open Filename:=myWb 'ブックを開くと同時にアクティブとなる
        lwn = ActiveWorkbook.Name   'パスを含まないブック名を取得しておく
        
        If ActiveSheet.ListObjects.Count > 0 Then   '念のための処理２
            For Each myLis In ActiveSheet.ListObjects
                myLis.Unlist
            Next myLis
        End If
        
        If Not ActiveSheet.AutoFilter Is Nothing Then   '開いたブックのシートにオートフィルターが設定されている場合は解除する
            Cells(y, x).AutoFilter
        End If
        
        lye = Cells(y, x).CurrentRegion.Rows(Cells(y, x).CurrentRegion.Rows.Count).Row
            
        If WorksheetFunction.CountIf(Rows(y & ":" & lye), "<>") <= nod Then '指定した最大値以下の場合のみ処理する
        
            Rows(y & ":" & lye).Copy
        
            Workbooks(awn).Activate
            aye = Cells(y, x).CurrentRegion.Rows(Cells(y, x).CurrentRegion.Rows.Count).Row
            Rows(aye + 1).Insert
        
            Workbooks(lwn).Application.CutCopyMode = False  'コピーモードを解除する
            
        Else
        
            cts2 = cts2 + 1
            
        End If
        
        Workbooks(lwn).Close savechanges:=False
        DoEvents    'Closeが完了するまで待つ

skip:

        ct = ct + 1
        Application.StatusBar = "処理実行中．．．" & ct & "/" & ctm
        
    Next myWb
    
    ChDrive Bcdrive
    ChDir Bcdir
    
    MsgBox "処理成功：" & ct - cts1 - cts2 & "/" & ctm & vbCrLf & "スキップ：" & cts1 + cts2 & "（Open重複：" & cts1 & _
    "，最大数超過：" & cts2 & "）"
    
    Application.StatusBar = False

End Sub

このマクロの動作確認をするために、色々なブックを使ってテストしてみたんですが、データをコピーする際にデータ数があまりに多いとフリーズしてしまうようです。
私の環境では約35,000を超えるデータ（1,000行×35列にびっしりとデータが詰まっている感じ）から、動作が不安定になるので、環境によって取り扱えるデータ数を増減できるようにしてみました。（ユーザーが指定したデータ最大数を超えてコピーしようとすると、コピーせずに次のブックに処理を飛ばします）
感覚的に、同じデータ数でも、縦に長いより横に長いほうが処理が思いように感じます。
コピーする場合ほどではないにせよ、ペーストされる側のブック（常時開いたままになるブック）にデータが多い場合も、処理が重くなるように感じたので、これも先に指定した値を超えるデータを含むブックであった場合、処理できない（マクロを実行できない）ようにしました。
フリーズを避けるために、がんじがらめにしてしまいましたが、PCのスペックが高いのならば最大値を2,147,483,647（約46340行×46340列）まで拡げることもできるのではないかと思います。

補足：

• ブックを処理する順番は、ファイル選択のダイアログボックスで選択した順ではなく、ダイアログボックスでの表示順（上から）になります（要するに上から順番に配列に格納される）。なので、順番を変えたい場合は、ダイアログボックスで右クリックし、名前順・更新日時順・サイズ順などで並び替えて下さい。

  

• 処理の対象となるブックにブック保護・シート保護・セル保護などがかかっていないことを確認して下さい。
• データの下端はCurrentRegionで判定します。CurrentRegionでどのような範囲が取得されるかは、該当のセルで「Shift」＋「Ctrl」＋「*」を押せば確認することができます。（該当のセルが空白でも、隣接する8方向のいずれかにデータが存在していれば、そこから空白で囲まれたデータ郡を矩形範囲で選択します）

ブックを開く・コピーする・ペーストする・ブックを閉じるといった、人間が行う処理をマクロで原始的に行っているだけなので、数が多くなるとどうしても処理に時間がかかります。
といっても、トイレに行って戻ってくる頃には終わっていますが･･････。
もっとこう、せっかくプログラムを使うのだから、内部的に処理できないものなのかな？（画面表示の更新をFalseにするという意味ではなく）