Copy ranges of data from Master worksheet. Thanks

[Prefcustmer]

Greetings! I've been trying to create a Macro that does the
following:


Background Info.

The Workbook name is Year02.xls
This workbook has about a hundred worksheets.
The first worksheet is named "02Master"
The first worksheet (02Master) contains data starting at A1 and ending
at L376, row A is just text headers.
Each row of data, starting with row A2, contains data for a given
date, starting with Dec 17th, 2001. Column G contains the raw date
number, 37242, for that date, and this column is incremented by one
down the column to track each following date. The other columns
contain work hours, etc.
The next worksheet is named "02-Week1:
Then next worksheet is named "02-Week2"
And so on for the next fifty one sheets.




Question:
I need to copy the data from "02-Master" in seven day blocks to each
worksheets, starting with worksheet 02-Week1.

So, worksheet 02-Week1 will contain the data from 02Master beginning
with Row 2 through and including Row 8.
Worksheet 02-Week2 will contain the data from 02Master from Row 9
through and including Row 15.
And Etc, etc, up to Row 376.

I hope I didn't belabor this too long, and I appreciate any input.
FWIW, I have to do this same exercise for Year 03 too, Beginning with
datecode 37617, Dec 27, 2002.

THANKS!

 

[Bull Splat]

This doesn't look too hard, but I can't help ya, I'm just learning VB
programming. You could do some of this with the Macro recorder, but
the rest is out of my league. I'm certain that someone here will come
up with a solution. GOOD LUCK!

 

[Dave Peterson]

Don't you end up with 54 weeks in your first year? I did.

This kind of sounds like a one time thing (or a yearly thing at best).

I'd run the macro for 02-Week#, then change a few things, then run the macro
again for 03-Week#.

Option Explicit
Sub testme01()

Dim mstrWks As Worksheet
Dim testWks As Worksheet
Dim destCell As Range
Dim iRow As Long
Dim iCtr As Long

'change this to match the correct year
Const wksPfx As String = "02-Week"

Set mstrWks = Worksheets("02Master")

iCtr = 0
With mstrWks
'change the starting and ending rows to match the year.
For iRow = 2 To 376 Step 7
iCtr = iCtr + 1
Set testWks = Nothing
On Error Resume Next
Set testWks = Worksheets(wksPfx & iCtr)
On Error GoTo 0
If testWks Is Nothing Then
'yy-Week# doesn't exist--what to do???
'MsgBox "worksheets " & wks_pfx & iRow & " Doesn't exist"
'Exit Sub 'quit???? or create the workbook???
Set testWks = Worksheets.Add
testWks.Name = wksPfx & iCtr
End If

With testWks
Set destCell = .Cells(.Rows.Count, "A").End(xlUp)
If IsEmpty(destCell) Then
'do nothing
Else
Set destCell = destCell.Offset(1, 0)
End If
End With

.Cells(iRow, 1).Resize(7, 12).Copy _
Destination:=destCell
Next iRow
End With

End Sub

I left a couple of comments in the code where you'd have to make the changes.
(I really wasn't sure if your row numbers were what you wanted--but you should
be able to verify and make the necessary changes.)

And run it against a copy of your workbook (or don't save it if it's wrong).

 

[Prefcustmer]

Dave:

Thanks for your reply. I have to use this Macro for years, 00, 01, 02
and 03, plus, we have numerous employees that each need their own
spreadsheets.

I appreciate your assistance, and I'm testing your solution now.
THANKS!

 

[Prefcustmer]

Dave:

Thanks for your reply. I have to use this Macro for years, 00, 01, 02
and 03, plus, we have numerous employees that each need their own
spreadsheets.

I appreciate your assistance, and I'm testing your solution now.
THANKS!