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