☰

宏建议 - 如果某些单元格显示“否”，则将行粘贴到新工作表中

tag-icon • tag-icon microsoft-excel vba macros
宏建议 - 如果某些单元格显示“否”，则将行粘贴到新工作表中

我想要一些使用 VBA 和宏的建议。

我想要一种链接工作表的方法（工作表 1 至 6) 与主表 (工作表 7）。

如果行包含“不”在列中I（整个工作表 1 至 6），可以将代码复制并粘贴该行到工作表 7？

然后如果行（在工作表 1 至 6) 改为“是的” 另一个代码是否可以删除该行工作表 7？

对于某些情况，工作表 1 至 6是一份工作清单，'是的'&'不'是客户是否已付款。如果'不'他们被添加到债务人名单上工作表 7。 如果'是的'他们需要被从债务人名单中剔除。

答案1

此代码将帮助您：

Public Sub debtors()
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim wksdest As Worksheet
    Set wkb = ThisWorkbook
    Set wksdest = wkb.Sheets("Sheet7")
    wksdest.Rows.Clear 'Clear the contents of Sheet7
    destRow = 1 'First row on Sheet7
    For i = 1 To 6 'Loop through Sheets 1 to 6
        newIndex = Right(Str(i), 1)
        thisSheet = "Sheet" + newIndex
        Set wks = wkb.Sheets(thisSheet)
        wks.Activate
        'Selects column I
        Columns("I:I").Select
        'Find a coincidence with the string "NO"
        Set cell = Selection.Find(What:="NO", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        'If there is a coincidence (is Not Nothing)
        If Not cell Is Nothing Then
            firstRow = cell.Row
            newRow = cell.Row
            'Copy the row and paste on Sheet7
            wks.Rows(newRow).Copy
            wksdest.Rows(destRow).PasteSpecial xlPasteValues
            destRow = destRow + 1
            foundValue = True
            'Find next coincidences in the same sheet
            While foundValue
                Set cell = Selection.FindNext(cell)
                If Not cell Is Nothing Then
                    newRow = cell.Row
                    If newRow <> firstRow Then
                        wks.Rows(newRow).Copy
                        wksdest.Rows(destRow).PasteSpecial xlPasteValues
                        destRow = destRow + 1
                    Else
                        foundValue = False
                    End If
                Else
                    foundValue = False
                End If
            Wend
        End If
    Next i
    wksdest.Activate
End Sub

使用ALT+打开 VBA/宏F11，在本工作簿插入一个新的模块并将代码粘贴在右侧。

单击绿色三角形来执行。

我对代码进行了注释，以便您了解它是如何工作的。

您也可以通过单击第一行逐步运行它，然后按 执行每个步骤F8。

相关内容