Recorrer un rango de celdas y exportar datos a otra hoja

el_ingenegro · el 7 de agosto

Saludos compañeros,

Necesito recorrer un rango de celdas en una hoja "PLANTILLAS" y validar cuáles son distintas de cero, las que cumplen el criterio uso esa referencia y el contenido en otras celdas (en esa misma hoja) para llevarlas a una tabla en una hoja "TABLA_DATOS" .

Soy novato en esto, hice una macro pero no se comporta como espero puesto que copia los datos que cumplen con los criterios y los que no también, además que la información la exporta cientos de veces (seguramente hay algo que no está bien definido con los bucles) . De antemano agradecido, espero puedan ayudarme. A continuación la macro:

Public Sub enviar_datos()

Application.ScreenUpdating = False

Dim contador As Integer
Dim celda As Range
Dim valor As Double

For Each celda In Range("E7:E34")

valor = celda.Value

If valor <> 0 Then

For contador = 7 To 34

Worksheets("TABLA_DATOS").Activate

Range("a2").EntireRow.Insert
Range("a2").Value = Worksheets("PLANTILLA").Range("D4").Value
Range("b2").Value = Worksheets("PLANTILLA").Range("F3").Value
Range("c2").Value = Worksheets("PLANTILLA").Range("I3").Value
Range("d2").Value = Worksheets("PLANTILLA").Range("I4").Value
Range("e2").Value = Worksheets("PLANTILLA").Cells(contador, 5).Value
Range("f2").Value = Worksheets("PLANTILLA").Cells(contador, 4).Value
Range("g2").Value = Worksheets("PLANTILLA").Cells(contador, 3).Value
Range("h2").Value = Worksheets("PLANTILLA").Cells(contador, 2).Value
Range("i2").Value = Worksheets("PLANTILLA").Cells(contador, 1).Value

Next contador

End If

Next celda

Application.ScreenUpdating = True

End Sub

Antoni · el 7 de agosto

No se si lo he entendido, si no es así, tendrás que subir el archivo y poner un ejemplo de lo que quieres.

Public Sub enviar_datos()
Application.ScreenUpdating = False
Dim celda As Range
With Sheets("TABLA_DATOS")
   For Each celda In Sheets("PLANTILLA").Range("E7:E34")
      If Not celda = 0 Then
         .Range("A2").EntireRow.Insert
         .Range("A2") = Sheets("PLANTILLA").Range("D4")
         .Range("B2") = Sheets("PLANTILLA").Range("F3")
         .Range("C2") = Sheets("PLANTILLA").Range("I3")
         .Range("D2") = Sheets("PLANTILLA").Range("I4")
         .Range("E2") = Sheets("PLANTILLA").Cells(celda.Row, "E")
         .Range("F2") = Sheets("PLANTILLA").Cells(celda.Row, "D")
         .Range("G2") = Sheets("PLANTILLA").Cells(celda.Row, "C")
         .Range("H2") = Sheets("PLANTILLA").Cells(celda.Row, "B")
         .Range("I2") = Sheets("PLANTILLA").Cells(celda.Row, "A")
      End If
   Next
End With
Application.ScreenUpdating = True
End Sub