Necesito Hacer una Macro que copie datos de Hoja1 a Hoja2 cuando cumpla condición. Sin dejar espacios en Blanco
Necesito hacer una macro que me copie datos de columnas A, B, C en la hoja2 siempre que la columna G sea mayor que 0. Pero que no me deje filas en blanco. Que se copien los datos en la primera fila en blanco de la hoja dos. Tengo una que copie de una pregunta anterior pero escribe en las mismas filas en hoja2 y me deja espacios.
Sub quiebres()
Set h1 = Sheets("hoja1")
Set h2 = Sheets("hoja2")
For i = 2 To 1000
If h1.Cells(i, "G") > 0 Then
h2.Cells(i, "A") = h1.Cells(i, "A")
h2.Cells(i, "B") = h1.Cells(i, "B")
h2.Cells(i, "C") = h1.Cells(i, "C")
End If
Next
End Sub
1 Respuesta
Solo tienes que cambiar por esta parte
Sub quiebres()
Set h1 = Sheets("hoja1")
Set h2 = Sheets("hoja2")
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To 1000
If h1.Cells(i, "G") > 0 Then
h1.Cells(i, "A").Copy h2.Cells(u2, "A")
h1.Cells(i, "B").Copy h2.Cells(u2, "B")
h1.Cells(i, "C").Copy h2.Cells(u2, "C")
u2 = u2 + 1
End If
Next
End Subsi te sirve valora mi trabajo.
Ahora si quieres establecer variables otra opción sería
Sub quiebres()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim Ho As Worksheet: Set Ho = wb.Sheets("Hoja1")
Dim Hd As Worksheet: Set Hd = wb.Sheets("Hoja2")
Dim ucel
'ucel = Hd.Range("A" & Rows.Count).End(xlUp).Row + 1
ucel = Hd.Cells(Hd.Rows.Count, 1).End(xlUp).Row + 1
For i = 2 To Ho.Range("A" & Rows.Count).End(xlUp).Row
If Ho.Cells(i, "G") > 0 Then
Ho.Cells(i, "A").Copy Hd.Cells(ucel, "A")
Ho.Cells(i, "B").Copy Hd.Cells(ucel, "B")
Ho.Cells(i, "C").Copy Hd.Cells(ucel, "C")
ucel = ucel + 1
End If
Next
End SubSi te das cuenta no necesariamente llega a 1000 , puede ser más o puede ser menos dependiendo de la cantidad de datos que tengas en la columna "A" de tu Hoja origen
