工作表合并，代码不能使用，求指导

divineson

套用的是“ykcbf1100”大神的代码，需汇总的数据是A站、B站、C站、D站，表格格式基本一样，就是列数有所增多，已按列数修改了代码，但还是不能使用，请求各位大神指点一下，教导一下类似的问题应如何修改代码，好学会后能自行修改了，谢谢！


Sub 合并工作表2()  '//2024.1.21
    Dim ss As Worksheet
    Application.ScreenUpdating = False
    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:ai" & 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:ai" & r1).Copy Sh.Cells(r + 1, 1)
                End If
            End With
        End If
    Next
    With Sh
       r = .Cells(Rows.Count, 1).End(3).Row
       For i = 3 To r
            If .Cells(i, 1) = "" Then .Cells(i, 1) = 9999
        Next
        Set Rng = .Range("a3:ai" & r)
        Rng.Sort .[a3], 1, , , , , , 1
        r = .Columns(1).Find("9999").Row
        .UsedRange.Offset(r - 1).Clear
    End With
    Application.ScreenUpdating = True
    MsgBox "工作表合并完毕！"
End Sub

shiruiqiang

divineson

shiruiqiang 发表于 2024-1-26 15:52

感谢老师的指导，我想汇总时保留一个表头，另外保持原格式汇总在一起，应如何修改，麻烦老师再指导一下，谢谢

wfywc81

用ChatGPT很快写了一个VBA代码，已对程序进行测试，可以使用。请查收！

cjc209

要保留原格式 就不能使用数组法 应该使用复制拷贝法

cjc209

搞好了 简单的无比   

cjc209

必须保持你的分表的表头和 列字段顺序都一样 不然要错位 这是前提

cjc209

再多列 再多表都可以使用

cjc209

你的4个表 合并就耗时0.11秒

ykcbf1100

既然楼主提到了，我不出手感觉说不过去。
简单改一下就可以了，代码的话不能完全套用，原来提取的是数字开头的表，现在要提取的是带有“站”的表，这一句改一下就行了，后面没用的代码删除即可。