Option Explicit

Sub CopyPaste()
    Const WBCOPY = "Z:\AAA.xlsx"
    Dim ws As Worksheet, rng As Range
    
    Set ws = ActiveWorkbook.Sheets("bbb")
    With Workbooks.Open(WBCOPY)
        Set rng = .Sheets("aaa").UsedRange
        ws.Range("A1").Resize(rng.Rows.Count, rng.Columns.Count) = rng.Value2
        rng.ClearContents
    End With
End Sub

调用Sub可以选择许多文件。对于每个选择的文件，提示输入所需的工作表名称。如果设置为空，则跳过该文件并继续下一个工作表。如果写入的工作表不存在，则会再次提示。

Option Explicit

'Copy this Sub in destination sheet "bbb"
Private Sub CopyPaste()
   Dim workbooktocopy As Workbook, sheettocopy As Worksheet, sheettopaste As Worksheet, endrow As Long
   Dim fn As Variant, fd As FileDialog, s As String, tmpWs As Worksheet, nextBook As Boolean, tr As Range
   Dim strinput As String
   
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   With fd
      .AllowMultiSelect = True
      .Title = "Select files from disk"
      .Filters.Add "XLSX", "*.xlsx"
      .Filters.Add "XLSXM", "*.xlsxm"
      .Filters.Add "All", "*.*"
      If .Show = True Then
         If Me.FilterMode Then
            Me.ShowAllData
         End If
         
         Set sheettopaste = ThisWorkbook.Worksheets("bbb")
         s = ""
         For Each fn In .SelectedItems
            Set workbooktocopy = Workbooks.Open(UCase(fn))
            Application.ScreenUpdating = False
            For Each tmpWs In workbooktocopy.Worksheets
               s = s & "@" & tmpWs.Name & "@" & vbCrLf
            Next
            
            nextBook = False
            Do
               strinput = InputBox("Sheets(" & workbooktocopy.Worksheets.Count & "): " & vbCrLf & s & vbCrLf & vbCrLf & "Write the desired sheet name without @" & vbCrLf, UCase(fn), "write the sheet name here")
               If strinput = "" Then
                  nextBook = True
                  Exit Do
               Else
                  If InStr(1, UCase(s), "@" & UCase(strinput) & "@") > 0 Then
                     Set sheettocopy = workbooktocopy.Sheets(strinput)
                     Exit Do
                  Else
                     MsgBox ("The sheet " & strinput & "does not exist!")
                  End If
               End If
            Loop
            
            If nextBook = False Then
               endrow = sheettopaste.Range("A" & sheettopaste.Rows.Count).End(xlUp).Row
               Set tr = sheettocopy.UsedRange    '.Range("A1:P250000").Copy
               tr.Copy
               sheettopaste.Activate
               sheettopaste.Range("A" & endrow + 1).PasteSpecial Paste:=xlPasteValues
               Application.CutCopyMode = False
               sheettocopy.Activate
               tr.Value = ""    ' or use: tr.ClearContents
               Call workbooktocopy.Close(True)
            End If
            
         Next fn
      End If
   End With
   Set fd = Nothing
End Sub