合并工作表问题，请各位大神指点一下

divineson

合并工作表时，不要将空行一并合并汇总，请各位大神帮忙修正一下代码，谢谢！


Sub 合并工作表2()  '//2023.12.5
    Dim ss As Worksheet
    Set sh = Sheets("汇总")
    sh.UsedRange.Clear
    For Each ss In Worksheets
        If Val(ss.Name) Then
            m = m + 1
            With ss
                If m = 1 Then
                    r1 = .Cells(Rows.Count, 1).End(3).Row
                    .Range("a1:j" & r1).Copy sh.Range("a1")
                Else
                    r = sh.Cells(Rows.Count, 1).End(3).Row
                    r1 = .Cells(Rows.Count, 1).End(3).Row
                    .Range("a3:j" & r1).Copy sh.Cells(r + 1, 1)
                End If
            End With
        End If
    Next
    MsgBox "工作表合并完毕！"
End Sub

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&, wks As Worksheet
   
    Application.ScreenUpdating = False
    With [A1].CurrentRegion
        .Offset(2).ClearContents
        r = 2
        ar = .Resize(10 ^ 3)
    End With
   
    For Each wks In Worksheets
        If wks.Name Like "*自查表" Then
            br = wks.[A1].CurrentRegion.Value
            For i = 3 To UBound(br)
                If Join(Application.Index(br, i), "") <> "" Then
                    r = r + 1
                    ar(r, 1) = r - 2
                    For j = 2 To UBound(br, 2)
                        ar(r, j) = br(i, j)
                    Next j
                End If
            Next i
        End If
    Next
   
    [A1].Resize(r, UBound(ar, 2)) = ar
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

ykcbf1100

原代码应该是我写的。
加段代码处理一下空行就可以了。
或者，改成数组法也行。

divineson

ykcbf1100 发表于 2024-1-21 13:51
原代码应该是我写的。
加段代码处理一下空行就可以了。
或者，改成数组法也行。

是的，感谢大神再次出手相助，谢谢！

divineson

gwjkkkkk 发表于 2024-1-21 13:13
请参考。。。

感谢大神的帮忙，谢谢！