VBA EXCEL 文件合并

Sub UnionWorksheets()
   
    Dim i  As Long            ' 循环变量
    i = 0
    
    Dim j  As Long            ' 循环变量
    j = 0
    Dim insert_row As Long    ' 合并文件中的粘贴位置    Application.ScreenUpdating = False
    Dim lj As String
    Dim dirname As String
    Dim nm As String
    
    lj = ActiveWorkbook.Path
    nm = ActiveWorkbook.Name
    dirname = Dir(lj & "/*.xls")
    
    Cells.Clear
    
    Do While dirname <> ""
        If dirname <> nm Then
        j = j + 1
        
            Workbooks.Open Filename:=lj & "/" & dirname
          
            Workbooks(nm).Activate
                    
            '复制新打开工作簿的第一个工作表的已用区域到当前工作表  '大哥们这个能不能写成循环,不然一个sheet来做一次好麻烦呀.
            
            
For i = 1 To Workbooks(dirname).Sheets.Count  With Workbooks(dirname).Sheets(i)
  
    If j = 1 Then
     Workbooks(dirname).Sheets(i).UsedRange.Copy _
     Sheets(i).Range("a65536").End(xlUp).Offset(1, 0)
    Else
    .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)).Copy _
    Sheets(i).Range("a65536").End(xlUp).Offset(1, 0)
    
   End If
  End With             
 Next          
          
          
              
            Workbooks(dirname).Close False
        End If
        
        
        dirname = Dir
    Loop
    
End Sub