スキルアップ・問題解決なら、モーグにおまかせ！

よろしくお願いします。
 
５つのコピー元ファイルから、１つのコピー先ファイルの５シートへデータをコピーしたいです。
ファイル名はセルに入力します。（A2〜A6）
コピーはデータの範囲がそれぞれ違います。
対象が１つの場合は出来ましたが、複数の場合がわかりません。
どなたかお願いいたします。
 
Sub まとめ()
 
Dim FilePath As String
Dim TargetFile As Workbook
 
    FilePath = ActiveSheet.Range("A2")
   
       If Dir(FilePath) <> "" Then
         
        Workbooks.Open FilePath
    Else
         
        MsgBox "ファイルが存在しません。処理を中止します。"
        Exit Sub
    End If
     
       Set TargetFile = ActiveWorkbook
         
    TargetFile.Sheets(1).Range("A1:A13").Copy
     
        ThisWorkbook.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteAll
     
       TargetFile.Close SaveChanges:=False
     
       Set TargetFile = Nothing
     
    MsgBox "完了しました"
    
    End Sub

＞コピーはデータの範囲がそれぞれ違います。
 
との事ですが、それぞれどう違うのですか？
 
サンプルでは、TargetFile.Sheets(1)については、Range("A1:A13")となっていますが、
これとて、いつもその範囲でいいのかさえ不明瞭に感じます。

疑問。確認
 
>ファイル名はセルに入力します。（A2〜A6）
 
このファイル名が入っているセルは、「Sheet1」のシートでは？
複写元ファイルのセル範囲を「sheet1」に複写しているが、問題ないのかな？
 
アドバイス
 
１．ファイル名の入っているセル（A2~A6)の右隣のセル（B2~B6)のセル範囲を入力しておく案は？
２．メインとサブにプrシジャを分ける
３．Thisworkbook側に不足するシートを作成するのは、手作業でするのかな？

参考コード
 

Sub MAIN()
Dim STNM, Sx As Long
Dim sht As Worksheet

    ReDim STNM(1 To 5, 1 To 2)
    For Sx = LBound(STNM) To UBound(STNM)
        STNM(Sx, 1) = "Sheet" & Sx
    Next
    With ThisWorkbook
        For Each sht In .Sheets
            For Sx = LBound(STNM) To UBound(STNM)
                If STNM(Sx, 1) = sht.Name Then
                    STNM(Sx, 2) = sht.Name
                    Exit For
                End If
            Next
        Next
        For Sx = LBound(STNM) To UBound(STNM)
            If STNM(Sx, 2) & "" = "" Then
                .Sheets.Add after:=.Sheets(.Sheets.Count)
                ActiveSheet.Name = STNM(Sx, 1)
            End If
        Next
    End With
    
Dim mycell As Range, RTNCD As Boolean
    
    With ThisWorkbook.Sheets(1)
        For Each mycell In .Range("A2: A6")
            RTNCD = サブ(PATHCELL:=mycell, COPYRANGE:=mycell.Offset(, 1))
            If RTNCD = False Then Exit Sub
        Next
    End With
    
End Sub

Function サブ(ByVal PATHCELL As Range, ByVal COPYRANGE As String)
Dim FilePath As String
Dim TargetFile As Workbook
 
    サブ = rtrue
    FilePath = PATHCELL.Value
    If Dir(FilePath) <> "" Then
        Set argetfile = Workbooks.Open(FilePath)
    Else
        MsgBox "ファイルが存在しません。処理を中止します。" & pathel.Value
        サブ = False
        Exit Function
    End If
        
    TargetFile.Sheets(1).Range(COPYRANGE).Copy
    ThisWorkbook.Sheets("Sheet" & pahell.Row - 1). _
            Range("A1").PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    TargetFile.Close SaveChanges:=False
     
    Set TargetFile = Nothing
     
'    MsgBox "完了しました"
    
End Function

半平太　さま
 
返信ありがとうございます。
コピー元ファイルはエクセルとCSVがあり、コピー範囲は列数は変わりませんが行数が毎回変わります。
全てのエクセルファイルが１シートのみです。
AA.xlsx A1:AN最終行
BB.xlsx A1:H最終行
CC.xlsx A2:AA最終行　A1セルに文字が入力されていて２行目が項目名３行目以降がデータになっている
DD.xlsx A1:AN最終行
EE.csv カンマ区切り 40列　１行目から取り込み０落ちしないように文字列にする
 
よろしくお願いいたします。

こんな感じかな？
 

Sub まとめ()
    Dim vTargetPath, vDestShNames, vWidthToCopy, Msg
    Dim targetFile As Workbook
    Dim destWsh As Worksheet
    Dim n As Long
    Dim fPath As String
    Dim qt As QueryTable
    
    vTargetPath = ActiveSheet.Range("A2:A6").Value
    vDestShNames = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
    vWidthToCopy = Array(40, 8, 27, 40)
    
    Application.ScreenUpdating = False
    
    For n = 1 To 5
        fPath = vTargetPath(n, 1)
        Set destWsh = ThisWorkbook.Worksheets(vDestShNames(n - 1))
        destWsh.UsedRange.Clear
        
        If Dir(fPath) = "" Then
            Msg = Msg & vbLf & fPath  '不存在
        ElseIf n < 5 Then
            Set targetFile = Workbooks.Open(fPath) '読み込み
            With targetFile.Sheets(1)
                .Range(IIf(n = 3, "A2", "A1"), .Cells(.Rows.Count, "A").End(xlUp)). _
                Resize(, vWidthToCopy(n - 1)).Copy
                destWsh.Range("A1").PasteSpecial Paste:=xlPasteAll
                .Range("A1").Copy 'dummyAction
                targetFile.Close SaveChanges:=False
            End With
        Else '5番目(csv）の場合はクエリで処理
            Set qt = destWsh.QueryTables.Add( _
            Connection:="TEXT;" & fPath, _
            Destination:=destWsh.Range("A1"))
            With qt
                .TextFileParseType = xlDelimited
                .TextFileCommaDelimiter = True
                .TextFileColumnDataTypes = [Column(A:AN)^0+1] '文字型読込
                .Refresh BackgroundQuery:=False
                .Delete                                'QueryTable を削除
            End With
        End If
        
    Next n
    
    Application.ScreenUpdating = True
    
    If Msg = "" Then
        MsgBox "完了しました"
    Else
        MsgBox "以下のファイルが存在しません" & vbLf & Msg
    End If
End Sub

半平太さま　　WinArrowさま
 
ご回答いただきありがとうございました！
希望通りに出来ました。
大変助かりました！