Excel VBA使用匹配的图纸名称和多个条件复制和粘贴数据

我是VBA新手，所以我不是很好。这是我第一个问题的后续问题

我有一个包含工作表“摘要”的工作簿（其中所有数据都被合并，如图1所示）、“8”、“9”、“10”。我想复制“Summary”中的数据，条件是如果列A中的单元格包含工作表名称（8、9或10），则该单元格的行和列C到E将粘贴到具有匹配名称的工作表中（如图2所示）。数据将粘贴在固定范围C7至E7、C14至E14、C21至E21等中（增量7）。但是，如果“Summary”的B列中的连续行具有相等的值，则它们将被粘贴在一起（模糊）。例如，“Summary”中A列的第2行到第6行中的单元格包含“8”，但B列的第2行和第3行具有类似的值，因此C列到E列的第2行到第6行将被复制并粘贴到第C7、C8、C14列的工作表“8”中，C21等，如图2所示。 链接到我的宏文件：

我有上一个线程中的ff代码，也许您可以添加或修改一些内容：

Sub Copy_Data()
Dim lastRow As Long, offsetRow As Long, i As Long, No As String, NOSheet As Worksheet, auxRow As Long, summarySheet As Worksheet
Set summarySheet = Worksheets("Summary")
lastRow = summarySheet.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
offsetRow = 7
For i = 2 To lastRow
    No = Cells(i, "A")
    Set NOSheet = Worksheets(No)
    auxRow = NOSheet.Columns("C").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    If auxRow > 1 Then auxRow = auxRow + 2
    If auxRow = 1 Then auxRow = offsetRow
    NOSheet.Cells(auxRow, "C") = summarySheet.Cells(i, "C")
    NOSheet.Cells(auxRow, "D") = summarySheet.Cells(i, "D")
    NOSheet.Cells(auxRow, "E") = summarySheet.Cells(i, "E")
Next i

端接头

谢谢你的帮助

---

为了比较SMR列，我还将该列复制到第8、9、10页。我还添加了一些评论

Sub Copy_Data()
    Dim lastRow As Long, firstRowToCopyData As Long, i As Long, No As Integer, NOSheet As Worksheet, auxRow As Long, summarySheet As Worksheet
    Dim increment As Long, SMR As String, prevSMR As String, firstNO As Integer, lastNO As Integer, k As Long
    
    Set summarySheet = Worksheets("Summary")
    lastRow = summarySheet.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'last row on Summary sheet
    firstRowToCopyData = 7
    increment = 7
    firstNO = 8
    lastNO = 10
    
    For No = firstNO To lastNO
        k = 0 'we use this varible to count unique SMR values
        For i = 2 To lastRow
            If summarySheet.Cells(i, "A") = No Then
                
                SMR = summarySheet.Cells(i, "B")
                Set NOSheet = Worksheets(CStr(No)) 'assuming sheets 8,9,10,etc already exists
                auxRow = NOSheet.Columns("C").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'last row on NOSheet
                If auxRow > 1 Then 'if there is existing data in NOSheet
                    prevSMR = NOSheet.Cells(auxRow, "B")
                    If prevSMR = SMR Then 'if consecutive same SMR value
                        auxRow = auxRow + 1
                    Else
                        k = k + 1
                        auxRow = increment * k 'auxRow=7,14,21...
                    End If
                ElseIf auxRow = 1 Then
                    k = k + 1
                    auxRow = firstRowToCopyData 'same than increment*k because firstRowToCopyData=increment
                End If
                
                NOSheet.Cells(auxRow, "A") = No
                NOSheet.Cells(auxRow, "B") = SMR
                NOSheet.Cells(auxRow, "C") = summarySheet.Cells(i, "C")
                NOSheet.Cells(auxRow, "D") = summarySheet.Cells(i, "D")
                NOSheet.Cells(auxRow, "E") = summarySheet.Cells(i, "E")
            End If
        Next i
    Next No
End Sub

---

哇！它工作得很好！下次你得用你的技能向我收费。非常感谢Di将我的工作表名称更改为字符串。我试着用数组来遍历这些表，但它们不起作用。你能帮我吗？