Question

我正在寻找关于这个问题的一些帮助。我在Excel 2007中使用VBA将表格从五个单独的工作表合并到一个工作表上。这在一个独立的工作簿中工作得很好，但是我需要将其移动到一个工作簿中，其他选项卡我不会合并数据。我尝试创建一个数组作为变量，其中包括我需要整合的五个工作簿，但我无法让它工作。以下是我使用的代码作为单独的过程：

Sub SummariseData()
    Dim x As Long, llastrow As Long, lfirstrow As Long
    Range("Data").CurrentRegion.Offset(1, 0).ClearContents
    Application.ScreenUpdating = False
    For x = 1 To Sheets.Count
        If Sheets(x).CodeName <> "Sheet1" Then
            If Sheets(x).Range("A2") <> "" Then
                lfirstrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
                llastrow = Sheets(x).Range("A1").End(xlDown).Row
                Sheets(x).Range("A2:N" & llastrow).Copy Destination:=Sheet1.Range("B" &          Rows.Count).End(xlUp).Offset(1, 0)
                Sheet1.Range("A" & lfirstrow & ":A" & lfirstrow + llastrow - 2) = Sheets(x).Name
            End If
        End If
    Next x

End Sub

anoyone可以帮助解决如何编写代码以专门调用我需要整合的五个选项卡，而不是循环遍历工作簿中的所有选项卡吗？选项卡名称为T1，T2，T3，T4，T5，所有这些都包含在选项卡调用摘要中。

Answer 1

尝试替换为：

Sub SummariseData()
    Dim x As Long, llastrow As Long, lfirstrow As Long

    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Summary")


    Range("Data").CurrentRegion.Offset(1, 0).ClearContents
    Application.ScreenUpdating = False
    For x = 1 To 5
        sheetName = "T" & x
        Set ws2 = Worksheets(sheetName)

        If ws2.Range("A2") <> "" Then
            lfirstrow = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
            llastrow = ws2.Range("A1").End(xlDown).Row
            ws2.Range("A2:N" & llastrow).Copy Destination:=ws1.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
            ws1.Range("A" & lfirstrow & ":A" & lfirstrow + llastrow - 2) = sheetName
        End If
    Next x

End Sub

有关我更改内容的详细信息：

我使用的是工作表对象，而不是每次都按名称调用工作表（ws1表示要复制的工作表 TO ，ws2表示工作表<您正在复制的strong> FROM 。
我使用了一个从1到5的循环，将该值连接到T，以获取选项卡名称。

Answer 2

你可以试试这个：

Dim sh As Worksheet, ws As Worksheet
Set ws = Thisworkbook.Sheets("Summary")

For Each sh in Thisworkbook.Sheets(Array("T1","T2","T3","T4","T5"))
    If sh.Range("A2").Value <> "" Then
        sh.Range("A1",sh.Range("A" & Rows.Count).End(xlUp).Offset(0,14).Address).Copy _
        ws.Range("B" & Rows.Count).End(xlUp).Offset(1,0)
        ws.Range(Range("A" & Rows.Count).End(xlUp).Offset(1,0).Address, _
            Range("B" & Rows.Count).End(xlUp).Offset(0,-1).Address).Value = sh.Name
    End If
Next

虽然没有经过测试，但我留给你了。

将多个工作表上的表合并到一个工作表

2 个答案: