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
[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
