目的:多个工作簿,指定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