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

Respuesta
1

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 Sub

si 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 Sub

Si 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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas