☰

Consejo de macro: pegar filas en una nueva hoja de trabajo, si ciertas celdas dicen "NO"

tag-icon • tag-icon microsoft-excel vba macros
Consejo de macro: pegar filas en una nueva hoja de trabajo, si ciertas celdas dicen "NO"

Me gustaría recibir algún consejo sobre el uso de VBA y macros.

Me gustaría encontrar una forma de vincular hojas de trabajo (hojas de trabajo 1 a 6) con una hoja maestra (hoja de trabajo 7).

Si la fila contiene"NO"en columna I(a lo largo dehojas de trabajo 1 a 6), ¿puede el código copiar y pegar esa fila enhoja de trabajo 7?

Entonces si la fila (enhojas de trabajo 1 a 6) fue cambiado a"SÍ" ¿Otro código podrá eliminar esa fila dehoja de trabajo 7?

Para algún contexto,hojas de trabajo 1 a 6son una lista de trabajos y el'SÍ'&'NO'son si el cliente ha pagado. Si'NO'se añaden a la lista de deudores elhoja de trabajo 7. Si'SÍ'deben ser eliminados de la lista de deudores.

Respuesta1

Este código te ayudará:

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 con ALT+ F11, debajoEste libro de trabajoinserte un nuevo módulo y pegue el código en el lado derecho.

Ejecútelo haciendo clic en el triángulo verde.

Puse comentarios sobre el código para que entiendas cómo funciona.

También puedes ejecutarlo paso a paso haciendo clic en la primera línea y luego pasar por cada paso presionando F8.

información relacionada