Question

提前感谢您对此问题的帮助。我有一套工作簿，其中包含不同数量的工作表。在每个工作表上，我需要将6个信息单元格编译到该工作簿中的一个主工作表上。信息的6个单元格位于每个工作表的同一页面上。我的最终输出将是一个工作表上的表，其中包含该书中其他工作表的所有数据。我可以手动完成，但希望宏能有所帮助。我尝试过使用activeworkbook.worksheet标识符但是卡住了。谢谢你的帮助。

Answer 1

我打算向@TheEngineer提出同样的建议，因为你的问题听起来过于笼统，唯一的答案似乎是有人为你编写完整的解决方案。

然而，仔细阅读，我认为你要求的是我在下面给你的循环。

Sub Macro1()
'
' Macro1 Macro
'
'
    ' 6 "working variables" to temporarily hold the values from each worksheet
    Dim sCell1 as String
    Dim sCell2 as String
    Dim sCell3 as String
    Dim sCell4 as String
    Dim sCell5 as String
    Dim sCell6 as String

    Dim iTargetRowIdx as Integer 'counter to point at next empty row in target sheet
    iTargetRowIdx = 1 'NOTE: change this if your 1st target row is not 1

    For Each Sheet In ActiveWorkbook.Sheets

        'avoid copying from the target worksheet itself
        If Sheet.Name <> "<your target sheet name>" Then

            'copy value from each of 6 cells to our working variables
            'INSTRUCTION: replace each pair of "<row>" and "<col>" with row and column numbers of each of your 6 cells
            sCell1 = Sheet.Cells(<row>, <col>) ' 1st cell to copy
            sCell2 = Sheet.Cells(<row>, <col>) ' 2nd cell to copy
            sCell3 = Sheet.Cells(<row>, <col>) ' 3rd cell to copy
            sCell4 = Sheet.Cells(<row>, <col>) ' 4th cell to copy
            sCell5 = Sheet.Cells(<row>, <col>) ' 5th cell to copy
            sCell6 = Sheet.Cells(<row>, <col>) ' 6th cell to copy

            'NOTE: if you want to see the value of what's in a cell while the macro is running, you can use Debug.Print, which prints to your Immediate Window (the little panel) at the bottom of the VBA editor) e.g.
            Debug.Print (Sheet.Cells(1, 1))
            'this prints what is in cell A1
            'NOTE: Debug.Print is just a debugging tool to help you see what is going on inside your macro - you can safely remove the statement altogether
        End If

        'then put code here to paste those values to the next row in your target worksheet
        'assumes you want the 6 values pasted to cols A to F in each new row
        Worksheets("<your target sheet name").Cells(iTargetRowIdx, 1) = sCell1
        Worksheets("<your target sheet name").Cells(iTargetRowIdx, 2) = sCell2
        Worksheets("<your target sheet name").Cells(iTargetRowIdx, 3) = sCell3
        Worksheets("<your target sheet name").Cells(iTargetRowIdx, 4) = sCell4
        Worksheets("<your target sheet name").Cells(iTargetRowIdx, 5) = sCell5
        Worksheets("<your target sheet name").Cells(iTargetRowIdx, 6) = sCell6

        iTargetRowIdx = iTargetRowIdx + 1 'point to next empty row
    Next Sheet
End Sub

这会遍历工作簿中的每个工作表。在循环内部，您可以完成所描述的所有工作。您需要编辑特定代码。

您没有说是否要为所有工作簿运行一个宏，或者只是在一个工作簿上运行。此宏仅针对一个工作簿运行，这是您放置此宏的工作簿。您可以将此宏放在您希望它工作的每个工作簿中，或者您可以发布有关如何在许多工作簿上运行一个宏的单独问题。

宏从未命名的工作表中提取数据

1 个答案: