Excel 批量合并EXCEL表的问题

 9楼A列没有数据，不能作为区域最后行的依据，下面代码修改了这一句：
Sub 同路径下的工作薄中合并到当前活动的工作表()
    Dim lj As String, dirname As String, nm As String, m As Integer
    Dim wb As Workbook, sht As Worksheet
    Set sh = ActiveSheet '活动工作表赋予对象变量sh
    lj = ThisWorkbook.Path '本文件路径
    nm = ThisWorkbook.Name '本文件名
    dirname = Dir(lj & "\*.xls") '使用Dir 函数取得本文件路径文件名
    Application.ScreenUpdating = False '关闭屏幕刷新
    sh.UsedRange.Clear '清除活动工作表已经使用区域所有
    Do While dirname <> "" '文件存在
        If dirname <> nm Then '不等于本文件名
            Set wb = GetObject(lj & "\" & dirname) '使用GetObject 函数引用这个工作簿
            m = m + 1 '计数，为了在第一次写表头
            With wb.Sheets(1) '对于引用工作簿第一表
                If m = 1 Then
                    .UsedRange.Copy sh.Range("a1") '带表头
                Else
                    .UsedRange.Offset(1, 0).Copy sh.Range("a" & sh.UsedRange.Rows.Count + 1) 'Offset(1, 0)中的1是表头只有1行，请自己修改
                End If
            End With
            wb.Close False '不保存关闭引用工作簿
        End If
        dirname = Dir '相同条件继续查找
    Loop '继续循环，直到 dirname = ""为止
    Application.ScreenUpdating = True
    MsgBox "完毕"
End Sub