代码修改

ddz79101

老师！我想合并3表中的A列，代码出现问题，请老师帮忙看看，谢谢！

shiruiqiang

很多是无效代码

shiruiqiang

Sub 合并表()
    Dim ws As Worksheet
    Dim Nsheet As Worksheet

    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "合并"

    For Each ws In ThisWorkbook.Sheets(Array("A", "B", "C"))
        If Sheets("合并").[a1] = "" Then
             ws.Range("A1:A1000").Copy Sheets("合并").[a1]
        Else
            ws.Range("A1:A1000").Copy Sheets("合并").Cells(Sheets("合并").UsedRange.Rows.Count + 1, 1)
        End If
    Next ws
End Sub

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, n&, wks As Worksheet
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    On Error Resume Next
    Worksheets("合并").Delete
    On Error GoTo 0
   
    With Worksheets.Add(after:=Worksheets(Worksheets.Count))
        .Name = "合并"
        For Each wks In Worksheets
            If InStr(",A,B,C,", "," & wks.Name & ",") Then
                n = n + 1
                wks.Columns(1).Copy .Cells(1, n)
            End If
        Next
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Beep
End Sub

gwjkkkkk

。。。。。。。

Qs18

Sub 合并表()
    Dim Nsheet As Worksheet
    Dim sht As Worksheet
    k = 0
    For Each sht In Sheets
        If sht.Name = "合并" Then
            k = k + 1
            MsgBox "合并表已经存在！"
            Exit For
        End If
    Next
    If k = 0 Then
        Set Nsheet = ThisWorkbook.Sheets.Add
        Nsheet.Name = "合并"
    End If
    arr = Array("A", "B", "C")
    For Each ws In arr
        k = Sheets(ws).Cells(Rows.Count, 1).End(xlUp).Row
        If Sheets("合并").Range("a1") = "" Then
            Sheets(ws).Range("A1:A" & k).Copy Sheets("合并").Range("a1")
        Else
            m = Sheets("合并").Cells(Rows.Count, 1).End(xlUp).Row + 1
            Sheets(ws).Range("A1:A" & k).Copy Sheets("合并").Range("a" & m)
        End If
    Next
End Sub

Qs18

试试....................

Qs18

试一下................

ddz79101

shiruiqiang 发表于 2024-6-23 16:51
很多是无效代码

谢谢老师！运行成功

ddz79101

gwjkkkkk 发表于 2024-6-23 17:00
。。。。。。。

谢谢老师！运行成功