将同一工作簿中的650个工作表合并为一页

时间:2019-03-21 20:17:18

标签: excel vba

此代码为我提供了所有工作表中的所有内容,甚至没有以匹配列的方式。我制作了一个VBA脚本,将所有127张excell单张纸都整理了下来,并将它们组合成一本包含600多个图纸的工作簿。我只希望将编号为空白的称为“功能依赖”的127张纸-127合并为一张纸。这些列有时在第一行中包含无用的数据,但其他情况下具有相似的列。有更好的方法吗?

Sub MergeAll()
Dim r As Long, ws As Worksheet, rAll As Long, wsAll As Worksheet
Dim i As Long

Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.name = "All"
Set wsAll = ActiveSheet
rAll = 2
For Each ws In Worksheets
If ws.name <> "All" Then
    r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For i = 1 To r
        wsAll.Cells(rAll, 1) = ws.name
        wsAll.Cells(rAll, 2) = ws.Cells(i, 1)
        wsAll.Cells(rAll, 3) = ws.Cells(i, 2)
        rAll = rAll + 1
    Next i
End If
Next ws
End Sub

1 个答案:

答案 0 :(得分:3)

Sub MergeAll()

    Dim r As Long, ws As Worksheet, rAll As Long, wsAll As Worksheet
    Dim i As Long, wb As Workbook

    Set wb = ThisWorkbook

    Set wsAll = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
    wsAll.name = "All"

    rAll = 2
    For Each ws In Worksheets
        If ws.name Like "Function Dependency*" Then

            r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

            For i = 1 To r

                wsAll.Cells(rAll, 1).Resize(1, 3).value = _
                      Array(ws.name, ws.Cells(i, 1), ws.Cells(i, 2))

                rAll = rAll + 1
            Next i

        End If
    Next ws

End Sub
相关问题