Macro para copiar filas no vacías de 2 tablas a otra tabla.
Tengo 2 tablas en una hoja y la información que se ingrese en ambas se consolida en 1 tabla en otra hoja. Es un formato para ser impreso, por ese motivo, he creado las tablas con 10 filas cada una, pero se podrían ingresar datos en 1 fila o varias cada vez que se use el formato. Ya tengo el código que copia los datos de cada celda en la tabla destino y trabaja bien, pero no logro condicionar que NO copie las filas vacías. Ya intenté con Cells(i, 1) <> " " y siempre copia 5 filas vacías en la tabla destino.

Comparto el código:
Sub Registrar()
Dim HojaOrigen As Worksheet
Dim TablaOrigen1 As ListObject
Dim TablaOrigen2 As ListObject
Dim HojaDatos As Worksheet
Dim Tabla As ListObject
Dim NuevaFila As ListRow
Dim FilasOrigen1, FilasOrigen2, i, Pregunta
Set HojaOrigen = ThisWorkbook.Sheets("Registro")
Set TablaOrigen1 = HojaOrigen.ListObjects("TablaO1")
Set TablaOrigen2 = HojaOrigen.ListObjects("TablaO2")
FilasOrigen1 = TablaOrigen1.ListRows.Count
FilasOrigen2 = TablaOrigen2.ListRows.Count
Set HojaDatos = ThisWorkbook.Sheets("RegRiesgos")
Set Tabla = HojaDatos.ListObjects("reg")
For i = 1 To FilasOrigen1
If Cells(i, 1) <> "" Then
Set NuevaFila = Tabla.ListRows.Add
With TablaOrigen1.ListRows(i)
NuevaFila.Range(5) = .Range(1).Value
NuevaFila.Range(10) = .Range(2).Value
NuevaFila.Range(11) = .Range(3).Value
NuevaFila.Range(12) = .Range(4).Value
NuevaFila.Range(13) = .Range(5).Value
NuevaFila.Range(14) = .Range(6).Value
NuevaFila.Range(16) = .Range(7).Value
NuevaFila.Range(17) = .Range(8).Value
NuevaFila.Range(26) = .Range(9).Value
NuevaFila.Range(27) = .Range(10).Value
NuevaFila.Range(1) = .Range(11).Value
NuevaFila.Range(4) = .Range(12).Value
NuevaFila.Range(6) = .Range(13).Value
NuevaFila.Range(7) = .Range(14).Value
NuevaFila.Range(8) = .Range(15).Value
NuevaFila.Range(18) = .Range(16).Value
NuevaFila.Range(19) = .Range(17).Value
End With
With TablaOrigen2.ListRows(i)
NuevaFila.Range(28) = .Range(2).Value
NuevaFila.Range(29) = .Range(3).Value
NuevaFila.Range(30) = .Range(4).Value
NuevaFila.Range(31) = .Range(5).Value
NuevaFila.Range(32) = .Range(6).Value
NuevaFila.Range(33) = .Range(7).Value
NuevaFila.Range(34) = .Range(8).Value
NuevaFila.Range(35) = .Range(9).Value
NuevaFila.Range(36) = .Range(10).Value
NuevaFila.Range(20) = .Range(11).Value
NuevaFila.Range(21) = .Range(12).Value
NuevaFila.Range(22) = .Range(13).Value
NuevaFila.Range(23) = .Range(14).Value
NuevaFila.Range(24) = .Range(15).Value
NuevaFila.Range(25) = .Range(16).Value
End With
End If
Next i
End Sub
2 Respuestas
Respuesta de Dante Amor
1
Respuesta de Elsa Matilde
3
