¿Es posible incluir en una macro que inserte filas en la tabla de destino dentro de una función set?
Al ejecutar la siguiente macro me he dado cuenta que me falta un aspecto importante, hay ocasiones en las que el número de filas que tengo en la tabla de destino es inferior al número de registros que le digo que copie de la tabla de origen, por tanto necesito decirle que no solo que me extraiga los datos sino que también me inserte filas si es necesario. El criterio sería cuando encontrará el texto "observaciones" en la columna C de tabla de destino debería de copiar los datos dos celdas más arriba como mucho. ¿Es posible?
Te pego la macro:
Sub Pasar_Datos_2()
'Por Dante Amor
Set h1 = Sheets("NO TOCAR_1")
Set h2 = Sheets("TABLA 1")
Set h3 = Sheets("TABLA 3")
Set h4 = Sheets("TABLA 9")
'
'Limpiar hojas
H2.Range("C20:G" & Rows. Count). ClearContents
h3.Range("C17:H" & Rows. Count). ClearContents
h4.Range("C17:H" & Rows. Count). ClearContents
'
'Leer tabla1 de la hoja "no tocar_1"
j = 20
i = 16
Do While h1.Cells(i, "E").Value <> ""
h2.Cells(j, "C").Value = h1.Cells(i, "E").Value
h2.Cells(j, "D").Value = h1.Cells(i, "H").Value
If h1.Cells(i, "I").Value <> 0 And h1.Cells(i, "I").Value <> "" Then
h2.Cells(j, "F").Value = h1.Cells(i, "I").Value
End If
If h1.Cells(i, "J").Value <> 0 And h1.Cells(i, "J").Value <> "" Then
h2.Cells(j, "G").Value = h1.Cells(i, "J").Value
End If
j = j + 1
i = i + 1
Loop
'
'Leer tabla3 de la hoja "no tocar_1"
j = 17
Set b = h1.Columns("C:K").Find("Tabla 3", lookat:=xlWhole)
If Not b Is Nothing Then
i = b.Row + 1
Do While h1.Cells(i, "E").Value <> ""
h3.Range(h3.Cells(j, "C"), h3.Cells(j, "F")).Value = _
h1.Range(h1.Cells(i, "E"), h1.Cells(i, "H")).Value
If h1.Cells(i, "I").Value <> 0 And h1.Cells(i, "I").Value <> "" Then
h3.Cells(j, "G").Value = h1.Cells(i, "I").Value
End If
If h1.Cells(i, "J").Value <> 0 And h1.Cells(i, "J").Value <> "" Then
h3.Cells(j, "H").Value = h1.Cells(i, "J").Value
End If
j = j + 1
i = i + 1
Loop
Else
MsgBox "No se encuentra el texto 'Tabla 3' en la hoja 'No tocar_1'"
Exit Sub
End If
'Leer tabla9 de la hoja "no tocar_1"
j = 17
Set b = h1.Columns("C:K").Find("Tabla 9", lookat:=xlWhole)
If Not b Is Nothing Then
i = b.Row + 1
Do While h1.Cells(i, "E").Value <> ""
h4.Range(h4.Cells(j, "C"), h4.Cells(j, "F")).Value = _
h1.Range(h1.Cells(i, "E"), h1.Cells(i, "H")).Value
If h1.Cells(i, "I").Value <> 0 And h1.Cells(i, "I").Value <> "" Then
h4.Cells(j, "G").Value = h1.Cells(i, "I").Value
End If
If h1.Cells(i, "J").Value <> 0 And h1.Cells(i, "J").Value <> "" Then
h4.Cells(j, "H").Value = h1.Cells(i, "J").Value
End If
j = j + 1
i = i + 1
Loop
Else
MsgBox "No se encuentra el texto 'Tabla 9' en la hoja 'No tocar_1'"
Exit Sub
End If
MsgBox "Fin"
End Sub
Te pongo fotos de la tabla de destino: