VBA combina varios archivos en una carpeta y extrae el nombre de cada archivo

Primero el problema

El trabajo debe combinar varios archivos pequeños de Excel en un solo archivo de Excel, el formato y el contenido del archivo son consistentes, porque hay muchos archivos, no considere pegar y copiar manualmente, considere directamente usar el programa VBA para resolver este problema.

                                                            Figura 1 Varios archivos de Excel en la misma carpeta

En segundo lugar, el código

Sub Abra todos los archivos en la carpeta y copie el contenido especificado ()

Dim a $, n As Long, i As Long, Num As Long, Name $    'Define n como el número de línea de inicio para la escritura, Num como el recuento de archivos, n se configura mejor como un entero largo, de lo contrario es fácil desbordar
Dim h % 'h se define como el número de líneas de contenido, excepto la primera línea (nombre del campo)
Dim mypath $
t = Timer
Application.ScreenUpdating = False
mypath = ActiveWorkbook.Path ' Obtenga la ruta de la carpeta de consulta donde se encuentra el archivo macro actual
a = Dir (mypath & "\ "&" * .xls ") 'Obtenga la ruta del archivo de la carpeta actual
Workbookss.Open mypath &" \ "& a' Recorre el archivo
Workbooks (a). Active
i = Sheets (" Sheet0 "). Range (" a65536 ") .Fin (xlUp) .Row 'Aquí. El número máximo de filas xls solo puede ser 65536
Workbooks (a) .Sheets ("Sheet0"). Range ("A2", "P" & i) .Copy Workbooks ("Summary") .Hojas ("Resumen"). Rango ("A2" )
Libros de trabajo ("汇总"). Hojas de cálculo ("汇总"). Rango ("Q2", "Q" e i) = a
Libros de trabajo (a) .Cierre
Num = 1
Name = Left (a, Len (a) - 4)
Do
a = Dir
 If a <> "" And a <> "汇总 .xlsm" Then
    Workbookss.Open mypath & "\" & a
    n = Workbooks ("汇总" ). Hojas ("汇总"). Rango ("a1048576"). Fin (xlUp). Fila + 1 Libros de trabajo
    (a). Activar
    i = Libros de trabajo (a). Hojas ("Hoja0"). Rango ("a65536") .Fin (xlUp) .Row
    Workbooks (a) .Sheets ("Sheet0"). Range ("A2", "P" & i) .Copy Workbooks ("汇总") .Sheets ("汇总") .Range (" A "& n)
    Libros de trabajo (" 汇总 "). Hojas de cálculo (" 汇总 "). Rango (" Q "& n," Q "& n + i - 2) = a
    Libros de trabajo (a). Close
    Num = Num + 1
    Name = Name & Left (a, Len (a) -4)
'MsgBox "Together:" & Num & "Files!"
 Else
    MsgBox "Together:" & Num & "Files! "&" Al compartir: "& (Timer-t) &" s "
    Salir Sub
 Fin Si
Loop
End Sub