合并接龙工作表

小星光

请老师帮我设置合并接龙工作表

杨建营

Sub test()
Dim i&, j&
Dim arr
Cells.ClearContents
For i = 1 To Sheets.Count
    If InStr(Sheets(i).Name, "表") Then
        With Sheets(i)
            arr = .UsedRange.Offset(1)
            If Application.CountA(Sheets(i).Cells) = 0 Then Exit For
            With Sheets("合并")
                j = .[a65536].End(3).Row
                If j < 2 Then
                    j = 2
                    .Range("a" & j).Resize(UBound(arr), UBound(arr, 2)) = arr
                Else
                    j = j + 1
                    .Range("a" & j).Resize(UBound(arr), UBound(arr, 2)) = arr
                End If
            End With
        End With
    End If
Next
End Sub
请楼主参考。

杨建营

附件请解压使用。

清风竹-

请看附件。

小星光

清风竹- 发表于 2023-3-10 08:20
请看附件。

非常感谢两位大师

jjmysjg

留下记号，谢谢蓝色

jjmysjg

清风竹- 发表于 2023-3-10 08:20
请看附件。

所有表的合并，怎么修改代码
谢谢

清风竹-

jjmysjg 发表于 2023-3-10 15:46
所有表的合并，怎么修改代码
谢谢

这句：If sht.name Like "*表*"     then      改为：If sht.name <> "合并"    then   '  '  "合并"  代表用于合并用表的名称，自己按实际修改。