Recorre bucle y pega rango de otra hoja si cumple condición

A tod@s! Ante todo muchas gracias por tomaros tiempo en contestar mi duda.

Tengo un libro excel donde en una hoja llamada INFORME quiero hacer una macro que recorra la columna B y si el valor de la celda es 1 haga la siguiente operación: según el valor de la columna C de esa fila, va a hoja VENTAS, busca este valor en la columna A y copia todo el rango de valores que exista en la columna B desde la fila siguiente al encabezado (el encabezado será la palabra ventassur o ventasnorte o ventaseste o ventasoeste)hasta el último valor insertado en esa venta. Una vez copiado los valores vuelve a la hoja INFORME e inserta las celdas copiadas en la columna A en la fila siguiente al valor 1 de la celda B que activó la condición. Una vez hecho esto continúa el bucle hasta recorrer todos los valores de la columna B de la hoja INFORME.

Aclaración: Donde se encuentra la base de datos en la hoja VENTAS puede variar en número de filas, es decir, está en función de los movimientos de ventas.

Adjunto fotos

Excel explicando mejor lo que solicito.

1 respuesta

Respuesta
1

[Hola 

Te paso la macro, crea 4 hojas con los respectivos nombres Norte, Sur, Este, Oeste.


Valora la respuesta para finalizar



Sub copiar()
'Por Adriel
'
    Set h1 = Sheets("INFORME")
    '
     u = h1.Range("B" & Rows.Count).End(xlUp).Row
     For i = 2 To u
     '
     Select Case h1.Cells(i, "B")
        Case 1: Set h = Sheets("Norte")
        Case 2: Set h = Sheets("Sur")
        Case 3: Set h = Sheets("Este")
        Case 4: Set h = Sheets("Oeste")
    End Select
    '
     u2 = h.Range("B" & Rows.Count).End(xlUp).Row + 1
     If h1.Cells(i, "B") <> "" Then h.Cells(u2, "B") = h1.Cells(i, "P")
    Next i
End Sub

Hice algunos ajustes

Sub copiar()
'Por Adriel
'
    Set h1 = Sheets("INFORME")
    '
     u = h1.Range("C" & Rows.Count).End(xlUp).Row
     For i = 2 To u
     '
     Select Case h1.Cells(i, "C")
        Case 1: Set h = Sheets("Norte")
        Case 2: Set h = Sheets("Sur")
        Case 3: Set h = Sheets("Este")
        Case 4: Set h = Sheets("Oeste")
    End Select
    '
     u2 = h.Range("B" & Rows.Count).End(xlUp).Row + 1
     If h1.Cells(i, "C") <> "" Then h.Cells(u2, "B") = h1.Cells(i, "P")
    Next i
End Sub

Hola Adriel. Según el problema que se me plantea, los datos estas en solo dos hojas, es decir, no debo crear 4 hojas adicionales porque la hoja VENTAS se va cargado de datos por la acción de una macro previa. Como puedes observar en la hoja Ventas los bloques de datos siempre se encuentran comprendidos entre 12 filas por debajo del encabezado. 

[Hola

Lo hice pensando si una venta tiene más de 12 filas, afectará a la otra venta y se puede mezclar los datos ...

Nunca puede tener más de 12 filas y no puedo añadir nuevas hojas al libro. Muchas gracias por tu atención y el tiempo prestado pero la solución que me ofreces no es lo que busco. 

Va la macro



Sub copiar()
'Por Adriel
'
'valora la respuesta para finalizar saludos!
'
    Set h1 = Sheets("INFORME")
    Set h2 = Sheets("VENTAS")
    '
     u = h1.Range("C" & Rows.Count).End(xlUp).Row
     '
     For i = 2 To u
        Set b = h2.Columns("A").Find(h1.Cells(i, "C"), lookat:=xlWhole)
        If Not b Is Nothing Then
            f = b.Row
            Do While h2.Cells(f, "B") <> ""
             f = f + 1
            Loop
            h2.Cells(f, "B") = h1.Cells(i, "P")
        End If
    Next i
    '
    MsgBox "fin"
End Sub

No funciona. No inserta filas en hoja informe

Envíame una copia de tu archivo [email protected]

Va la macro

Valora la respuesta para finalizar



Sub copiar()
'Por Adriel
'
'valora la respuesta para finalizar saludos!
'
    Set h1 = Sheets("INFORME")
    Set h2 = Sheets("VENTAS")
    '
     u = h1.Range("B" & Rows.Count).End(xlUp).Row
     '
     For i = u To 2 Step -1
        If h1.Cells(i, "B") > 0 Then
            Set b = h2.Columns("A").Find(h1.Cells(i, "C"), lookat:=xlWhole)
            If Not b Is Nothing Then
                f = b.Row
                n = 0
                Do While h2.Cells(f, "B") <> ""
                 f = f + 1
                 n = n + 1
                Loop
                    h1.Rows(i + 1 & ":" & i + n - 1).Insert Shift:=xlDown
                    h2.Range(h2.Cells(b.Row + 1, "B"), h2.Cells(f - 1, "B")).Copy
                    h1.Range("A" & i + 1).PasteSpecial xlValues
            End If
        End If
    Next i
    '
    MsgBox "fin"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas