多个工作簿,指定Sheet工作表数的据合并到一个新的Sheet页里面,求一个VBA代码?

 目的:多个工作簿,指定Sheet工作表的数据合并;

要求:

1、如上图,有两个工作簿,每个工作簿里有多个工作表,需要将两个工作簿指定Sheet工作表(战力值排名)的数据合并在一个新工作簿的新Sheet页里面(新的Sheet页需命名为“数据汇总”);

2、新的Sheet页里面合并的数据只保留一个表头;

3、新的Sheet页里面合并的数据之间必须连贯,不能有空白行;

4、新的Sheet页里面合并的数据格式为“常规”格式;

5、如果需要合并的数据有筛选或隐藏,在合并数据时取消筛选和隐藏,合并Sheet页里的所有数据;

6、数据合并完成后,会有一个弹窗提示,提示当前合并了多少个工作表的数据;

7、Excel里面的代码,选择文件和指定合并Sheet页的代码请加上中文注释

求大神指点!!!求大神指点!!!求大神指点!!!求大神指点!!!求大神指点!!!求大神指点!!!


Sub MergeDataFromWorksheets()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim mergeWs As Worksheet
    Dim sourceRange As Range
    Dim nextRow As Long
    
    '设置合并数据的目标工作表
    Set mergeWs = ThisWorkbook.Worksheets("合并数据")
    
    '打开需要合并数据的工作簿
    Set wb = Workbooks.Open("D:\工作簿1.xlsx")
    
    '循环处理每个工作簿
    For Each ws In wb.Worksheets
        If ws.Name = "指定工作表" Then '设置需要合并数据的工作表
            
            '找到需要复制的行范围
            Set sourceRange = ws.Range("A2:F10") '修改为实际需要复制的行范围
            
            '找到下一行要写入数据的行号
            nextRow = mergeWs.Cells(Rows.Count, "A").End(xlUp).Row + 1
            
            '将源数据复制到目标工作表的下一行
            sourceRange.Copy Destination:=mergeWs.Range("A" & nextRow)
            
            '释放对象变量
            Set sourceRange = Nothing
            
        End If
    Next ws
    
    '关闭打开的工作簿
    wb.Close SaveChanges:=False
    
    '重复上述代码,处理其他需要合并的工作簿
    
End Sub