SPGL和FERT两个表的数据合并到一个表里

yanglinzi

宝玉66 发表于 2024-10-29 16:18
老师,代码输入后报错。

我这边正常，可能是d(sb)出现空置了，那是对应的列号

yanglinzi

宝玉66 发表于 2024-10-29 16:18
老师,代码输入后报错。

确认每一个输入的字符都是正确的，才不会报错。

宝玉66

yanglinzi 发表于 2024-10-29 16:51
确认每一个输入的字符都是正确的，才不会报错。

好的,谢谢老师。

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim i&, r&, Rng As Range
   
    Application.ScreenUpdating = False
   
    With Worksheets(1)
        .Cells.Clear
        For i = 2 To Worksheets.Count
            With Worksheets(i)
                If i = 2 Then
                    Set Rng = .[A1].CurrentRegion
                Else
                    With .[A1].CurrentRegion
                        Set Rng = Intersect(.Offset(), .Offset(1))
                    End With
                End If
            End With
            r = .Cells(.Rows.Count, "A").End(xlUp).Row
            r = IIf(r = 1, 1, r + 1)
            Rng.Copy .Cells(r, 1)
        Next i
        .Activate
    End With
        
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

。。。。。。。

宝玉66

gwjkkkkk 发表于 2024-10-29 19:48
Option Explicit
Sub TEST2()
    Dim i&, r&, Rng As Range

谢谢老师   

永不加班

看看行不行
Sub 合并()

Dim k, i, j

Worksheets("SPGL").Select
    k = 1
    Do While Range("a" & k) <> ""
        k = k + 1
    Loop
        Range(Cells(2, 1), Cells(k - 1, 6)).Select
        Selection.Copy
Worksheets("spgl&fert合并").Select
    Range("a2").Select
    ActiveSheet.Paste

Worksheets("FERT").Select
    i = 1
    Do While Range("a" & i) <> ""
        i = i + 1
    Loop
        Range(Cells(2, 1), Cells(i - 1, 6)).Select
        Selection.Copy
Worksheets("spgl&fert合并").Select
    j = 1
    Do While Range("a" & j) <> ""
        j = j + 1
    Loop
Range("a" & j).Select
ActiveSheet.Paste


End Sub

ykcbf1100

参与一下，这算比较简单的合并了。

ykcbf1100

参与一下，数组