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