Quote:
Originally Posted by BjornS
Hi,
try this!
Activate the sheet "My Macros" and then run the macro below. This should turn this sheet into same appearance as the sheet "Final".
Kind regards
Bjorn
Sub FixRows()
Application.ScreenUpdating = False
Dim rownum As Long
Dim rowhour As Long
rownum = 4
rowhour = 0
Do Until Cells(rownum, 4).Value = "" And rowhour = 0
If Cells(rownum, 4).Value <> rowhour And Cells(rownum, 4).Value Mod 100 = 0 Then
Cells(rownum, 1).EntireRow.Insert
Cells(rownum - 1, 1).Range("A1:L1").Copy _
Destination:=Cells(rownum, 1)
Cells(rownum, 4).Value = rowhour
If rowhour Mod 300 = 0 Then
With Cells(rownum, 5)
.NumberFormat = "0"
.FormulaR1C1 = "9999"
.Interior.ColorIndex = 6
.Interior.Pattern = xlSolid
.Borders.LineStyle = xlcontinous
.Borders.Weight = xlThin
.Borders.ColorIndex = xlAutomatic
End With
Cells(rownum, 5).Copy Destination:=Cells(rownum, 1).Range("E1:L1")
End If
End If
rownum = rownum + 1
rowhour = rowhour + 100
If rowhour = 2400 Then rowhour = 0
Loop
Application.ScreenUpdating = False
End Sub
|
WOW!! It worked!!! Thank you very much, I will try on a full data, I will try it for a year and I will let you know about the results, and tomorrow I will attach the re-recorded macro. Again, thank you very much BjornS
) you saved me
)