|
- Sub 合并()
- Dim wb As Workbook
- Dim i&, addr$, j&
- With ThisWorkbook
- For i = 1 To .Worksheets.Count
- Debug.Print .Worksheets(i).Name,
- If .Worksheets(i).Name Like "*.*.*" Then
- .Worksheets(i).UsedRange.Copy
- Exit For
- End If
- Next
- Set wb = Workbooks.Add
- Cells(Rows.Count, 1).End(xlUp).PasteSpecial
- For j = i + 1 To .Worksheets.Count
- If .Worksheets(j).Name Like "*.*.*" Then
- addr = Replace(.Worksheets(j).UsedRange.Address, "$A$1", "$A$5")
- .Worksheets(j).Range(addr).Copy
- Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
- End If
- Next
- End With
- MsgBox "工作表已经合并到" & wb.Name & ",请保存"
- End Sub
复制代码 |
评分
-
查看全部评分
|