Question

用EXCEL Vba合并当前目录下所有工作簿的全部工作表的代码会丢数据，请帮忙修改一下

Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
'For G = 1 To Sheets.Count
Wb.Sheets(1).Range("a2:s" & [A65536].End(xlUp).Row).Copy Sheets(1).Cells(.Range("A65536").End(xlUp).Row + 1, 1)

Wb.Sheets(2).Range("a2:s" & [A65536].End(xlUp).Row).Copy Sheets(2).Cells(.Range("A65536").End(xlUp).Row + 1, 1)
'Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

用这段代码合并后，如果当前选择的是sheet1，那么sheet1的数据不会丢，sheet2里面数据会有丢失。但换成sheet2为当前选择再执行，sheet1的数据又有丢失，不知道为什么。
目的是为了让目录下所有工作簿的sheet1表合并到合并文件的sheet1表中，sheet2表合并到合并文件的sheet2表中，请帮忙修改一下，谢谢

Answer 1

Sub 合并当前目录下所有工作簿的全部工作表()
    Dim MyPath, MyName, AWbName
    Dim Wb As Workbook, WbN As String
    Dim G As Long
    Dim Num As Long
    Dim BOX As String
    Application.ScreenUpdating = False
    MyPath = ActiveWorkbook.Path
    MyName = Dir(MyPath & "\" & "*.xls")
    AWbName = ActiveWorkbook.Name
    Num = 0
    Do While MyName <> ""
        If MyName <> AWbName Then
            Set Wb = Workbooks.Open(MyPath & "\" & MyName)
            Num = Num + 1
       
                'For G = 1 To Sheets.Count
                    Wb.Sheets(1).Range("a2:s" & [A65536].End(xlUp).Row).Copy Workbooks(1).Sheets(1).Cells(Workbooks(1).Sheets(1).Range("A65536").End(xlUp).Row + 1, 1)
                    
                    Wb.Sheets(2).Range("a2:s" & [A65536].End(xlUp).Row).Copy Workbooks(1).Sheets(2).Cells(Workbooks(1).Sheets(2).Range("A65536").End(xlUp).Row + 1, 1)
                'Next
                WbN = WbN & Chr(13) & Wb.Name
                Wb.Close False
        
        End If
        MyName = Dir
    Loop
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

Answer 2

    Sub aa()
    Do While MyName <> ""
        If MyName <> AWbName Then
            Set wb = Workbooks.Open(MyPath & "\" & MyName)
            '如果要copy的工作薄中工作表的数量大于当前工作薄中工作表的数量
            '就在当前工作薄中创建新的工作表,使两者数量相等
            If wb.Sheets.Count > Sheets.Count Then
                For i = 1 To wb.Sheets.Count - Sheets.Count
                    Sheets.Add after:=Sheets(Sheets.Count)
                Next
            End If
            
            Num = Num + 1
            For G = 1 To wb.Sheets.Count '以打开的工作薄的工作表数量为准,以避免打开工作薄中工作表数量不足产生错误
                '产生数据丢失的问题就是发生在下面这句,仔细对比你应该能发现问题(错误已修正)
                wb.Sheets(G).Range("a2:s" & wb.Sheets(G).[A65536].End(xlUp).Row).Copy Sheets(G).Cells(Sheets(G).Range("A65536").End(xlUp).Row + 1, 1)
            Next
            WbN = WbN & Chr(13) & wb.Name
            wb.Close False
        End If
        MyName = Dir
    Loop

    End Sub

Answer 3

[A65536]这个最好指明是哪个sheet的A65536。这里可能默认成了activesheet的A65536，而不是Wb.Sheets(1)的，这样如果你的Wb.Sheets(1)和Wb.Sheets(2)的行数不一致的话，第一个导入的行数会是对的，第二个导入的就不对了。