☰

Conselho de macro - Colando linhas em uma nova planilha, se determinadas células indicarem "NÃO"

tag-icon • tag-icon microsoft-excel vba macros
Conselho de macro - Colando linhas em uma nova planilha, se determinadas células indicarem "NÃO"

Gostaria de alguns conselhos sobre VBA e Macros.

Eu gostaria de uma maneira de vincular planilhas (planilhas 1 a 6) com uma folha mestre (planilha 7).

Se a linha contiver"NÃO"em coluna I(em todoplanilhas 1 a 6), o código pode copiar e colar essa linha emplanilha 7?

Então se a linha (emplanilhas 1 a 6) foi alterado para"SIM" outro código será capaz de excluir essa linha deplanilha 7?

Para algum contexto,planilhas 1 a 6são uma lista de empregos e o'SIM'&'NÃO'são se o cliente tiver pago. Se'NÃO'eles são adicionados à lista de devedores emplanilha 7. Se'SIM'eles precisam ser retirados da lista de devedores.

Responder1

Este código irá ajudá-lo:

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

Abra VBA/Macros com ALT+ F11, emEsta pasta de trabalhoinsira um novo módulo e cole o código no lado direito.

Execute-o clicando no triângulo verde.

Coloquei comentários no código para que você entenda como ele funciona.

Você também pode executá-lo passo a passo clicando na primeira linha e depois seguir cada etapa pressionando F8.

informação relacionada