MACRO: Para insertar nuevas filas antes de después de los nombres de automóviles
Deseo que me ayuden con una macro que pueda insertar 1 fila al inicio y final de cada lista o nombre de automóvil.
La macro quedaría así: se aumentaría también la fecha, la guardia la placa del automóvil, los demás datos los ingresaremos manualmente.
Los datos serán de día y noche la misma estructura.
Juan Perez
1 respuesta
Una consulta a fin de poder darte un código, ¿la celda "B30" debería decir noche? ¿Por qué dice día? En la segunda imagen
Juan por favor prueba y valida este código a ver si te sirve para lo que necesitas, se está tomando como campo de revisión la columna "c" suponiendo que la data comience en la fila 6 tal y como está en la primera imagen, la macro tiene un bucle que ejecuta hasta que consiga el último registro en la columna de revisión. Me avisas cualquier cosa.
Sub Insertar_Filas()
Dim Dato1
Dim Dato2
Dim LineaT
Dim Linea
Linea = 6
Application.ScreenUpdating = False
Range("A6").Select
Selection.EntireRow.Insert
Range("A6").Select
Range("A7:C7").Copy
ActiveSheet.Paste
Range("A6:C6").Select
With Selection.Font
.Color = -16776961
End With
Dato1 = 1
Dato2 = 1
Do Until Range("C" & Linea) = ""
Dato1 = Range("C" & Linea)
Linea = Linea + 1
Dato2 = Range("C" & Linea)
Do Until Dato1 <> Dato2
Dato1 = Range("C" & Linea)
Linea = Linea + 1
Dato2 = Range("C" & Linea)
Loop
Range("A" & Linea & ":" & "A" & Linea + 1).Select
Selection.EntireRow.Insert
Range("A" & Linea - 1 & ":" & "C" & Linea - 1).Copy
Range("A" & Linea).Select
ActiveSheet.Paste
With Selection.Font
.Color = -16776961
End With
Linea = Linea + 2
Range("A" & Linea & ":" & "C" & Linea).Copy
Range("A" & Linea - 1).Select
ActiveSheet.Paste
With Selection.Font
.Color = -16776961
End With
Loop
Application.CutCopyMode = False
Range("A5").Select
Application.ScreenUpdating = False
End Sub
