Recorrer un rango de celdas y exportar datos a otra hoja

[el_ingenegro]

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]

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

 

[el_ingenegro]

Saludos. Me sirvió perfectamente Master Antoni. Muchas gracias!?