macro to insert rows & copy cells
Hi,
Try this which determines day of week from date and inserts/copies
accordingly
HTH
Sub InsertandCopy()
Dim ws1 As Worksheet
Dim r As Long, Lastrow As Long
' Number of inserts for Sunday to Saturday ....
nInserts = Array(0, 0, 0, 1, 3, 3, 4, 0)
Set ws1 = Worksheets("Sheet1")
With ws1
Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
For r = Lastrow To 2 Step -1
n = nInserts(Weekday(Cells(r, 1)) - 1)
If n < 0 Then
.Rows(r + 1).Resize(n).Insert Shift:=xlDown
.Rows(r).Copy .Rows(r + 1).Resize(n)
End If
Next r
End With
End Sub
"D Hafer - TFE" wrote:
I need to create rows of data based on days of the week. I start with a
calendar date and delete rows for days of the week where there are no
records. I need to now insert rows based on the remaining days of the week.
Specifically, on Wednesdays, I need to insert 1 row and copy cells from the
row above. On Thursdays and Fridays, I need to insert 3 rows and copy the
respective cells from each day. On Saturdays, I need to insert 4 rows and
copy the cells for Saturday.
This needs to go through the entire data set for one month or two months.
Any ideas?
|