☰

Makro-Hinweis - Zeilen in ein neues Arbeitsblatt einfügen, wenn in bestimmten Zellen „NEIN“ steht

tag-icon • tag-icon microsoft-excel vba macros
Makro-Hinweis - Zeilen in ein neues Arbeitsblatt einfügen, wenn in bestimmten Zellen „NEIN“ steht

Ich hätte gerne einige Ratschläge zur Verwendung von VBA und Makros.

Ich würde eine Möglichkeit zum Verknüpfen von Arbeitsblättern (Arbeitsblätter 1 bis 6) mit einem Masterblatt (Arbeitsblatt 7).

Wenn die Zeile enthält"NEIN"in Spalte I(durchgehendArbeitsblätter 1 bis 6), kann der Code diese Zeile kopieren und einfügen inArbeitsblatt 7?

Wenn dann die Zeile (inArbeitsblätter 1 bis 6) wurde geändert in"JA" kann ein anderer Code diese Zeile löschen ausArbeitsblatt 7?

Zum Kontext:Arbeitsblätter 1 bis 6sind eine Liste von Jobs und die'JA'und'NEIN'sind, wenn der Kunde bezahlt hat. Wenn'NEIN'Sie werden in die Schuldnerliste aufgenommen amArbeitsblatt 7. Wenn'JA'Sie müssen aus dem Schuldnerverzeichnis gestrichen werden.

Antwort1

Dieser Code hilft Ihnen:

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

Öffnen Sie VBA/Makros mit ALT+ F11, unterDiesesArbeitsbuchFügen Sie ein neues Modul ein und fügen Sie den Code auf der rechten Seite ein.

Führen Sie es aus, indem Sie auf das grüne Dreieck klicken.

Ich habe dem Code Kommentare hinzugefügt, damit Sie verstehen, wie er funktioniert.

Sie können es auch Schritt für Schritt ausführen, indem Sie auf die erste Zeile klicken und dann durch Drücken der Taste jeden einzelnen Schritt durchgehen F8.

verwandte Informationen