Sub MergeExcelFiles()
    '定义变量,需统一的行高
    Dim wbk As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim wsDest As Worksheet
    Dim rngDest As Range
    Dim rngCopy As Range
    Dim intLastRow As Long
    Dim intLastCol As Long
    Dim intDestRow As Long
    Dim intDestCol As Long
    
    '选择文件夹
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub '如果用户点击取消，则退出
        myPath = .SelectedItems(1) & "\" '存储所选文件夹的路径
    End With
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    '创建新工作簿并选择第一个工作表作为合并的目标
    Set wbk = Workbooks.Add(xlWBATWorksheet)
    Set wsDest = wbk.Worksheets(1)
    Set rngDest = wsDest.Range("A1")
    
    '循环遍历文件夹中的所有Excel文件
    myFile = Dir(myPath & "*.xls*")
    intDestRow = 1 '初始化目标行数
    Do While myFile <> ""
    '打开文件并将数据复制到目标工作表中
    Set rngCopy = Workbooks.Open(myPath & myFile).Worksheets(1).UsedRange
    intLastRow = rngCopy.Rows.Count
    intLastCol = rngCopy.Columns.Count
    rngCopy.Copy wsDest.Cells(intDestRow, 1)
    
    '复制行高和列宽
    Dim srcRow As Range, destRow As Range
    For Each srcRow In rngCopy.Rows
        Set destRow = wsDest.Rows(intDestRow)
        destRow.RowHeight = srcRow.RowHeight
        intDestRow = intDestRow + 1
    Next srcRow
    wsDest.Columns.AutoFit '自动调整列宽
    
    '关闭源工作簿
    Workbooks(myFile).Close SaveChanges:=False
    
    '获取下一个文件
    myFile = Dir
    Loop
MsgBox "保持原有行高合并完成！", , "逗号技巧"
End Sub