|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
参与一下。。。
- Sub 多表合并() '//2024.5.23
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Set sh = ThisWorkbook.Sheets("汇总表")
- sh.Cells.Clear
- On Error Resume Next
- For Each sht In Sheets
- If sht.Name <> sh.Name Then
- If sht.Visible = -1 Then
- With sht
- .AutoFilterMode = False
- m = m + 1
- If m = 1 Then
- .Cells.Copy sh.Cells(1, 1)
- Else
- r = sh.UsedRange.Rows.Count
- r1 = .UsedRange.Find("总计").Row
- .Rows(4 & ":" & r1 - 1).Copy
- sh.Cells(IIf(m = 2, r, r + 1), 1).PasteSpecial Paste:=xlPasteAll
- sh.Cells(IIf(m = 2, r, r + 1), 1).PasteSpecial Paste:=xlPasteValues
- End If
- End With
- End If
- End If
- Next
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|