copying & Pasting Multiple Ranges within a workbook

[Ferret via OfficeKB.com]

Hi everyone, i'm new to Vba and i'm struggling. the story so far.
i have one workbook with 3 worksheets named - Master Roster, one named - dept
1&3, last one named - dept 2&4. these are leave plots for a four on four off
rotation. the leave plots are for 12 months.
on the department worksheets i have used named ranges for the individual
departments for every month i.e. "aprd1" = april dept 1.the ranges includes
the employee number,grading, name. it also includes the leave plot itself of
when they are working or off or when they are on sick, holiday etc.
for each worksheet there are 24 ranges names.

on the master roster there are 48 ranged names as the master roster is a
compilation of both the leave plots, and the depatments are in number order i.
e. dept 1, dept2, dept3, dept4.the named ranges on the master roster are like
i.e. "1dapr" almost the same as the departmental ones.what i'm trying to do
is when a change occurs in a range on the department leave plots it
automatically copies it to the master roster.
can anyone help me please
if you require anymore info let me know

thank you

ferret

 

[Joel]

See if this works. You need two worksheet changes one for Dept 1 & 3 and one
for Dept 2 & 4

for 1 & 3

Sub worksheet_change(ByVal target As Range)

For Dept = 1 To 3 Step 2
For MonthNum = 1 To 12
RangeName = MonthName(MonthNum, True) & "d" & Dept
If Not Intersect(target, Range(RangeName)) Is Nothing Then
DestRangeName = Dept & "d" & MonthName(MonthNum, True)
Range(RangeName).Copy _
Destination:=Sheets("Master Roster").Range(DestRangeName)
Exit Sub
End If
Next MonthNum
Next Dept
End Sub

for 2 & 4

Sub worksheet_change(ByVal target As Range)

For Dept = 2 To 4 Step 2
For MonthNum = 1 To 12
RangeName = MonthName(MonthNum, True) & "d" & Dept
If Not Intersect(target, Range(RangeName)) Is Nothing Then
DestRangeName = Dept & "d" & MonthName(MonthNum, True)
Range(RangeName).Copy _
Destination:=Sheets("Master Roster").Range(DestRangeName)
Exit Sub
End If
Next MonthNum
Next Dept
End Sub

 

[Ferret via OfficeKB.com]

Hi Joel,
i have tried the code and works fantastic in 2003 which is what we are using.
many thanks
i tried this in excel 2007 but it came up with an error saying "Can't find
project or library" any hints as i'm curious?

many thanks again

Ferret

See if this works. You need two worksheet changes one for Dept 1 & 3 and one
for Dept 2 & 4

for 1 & 3

Sub worksheet_change(ByVal target As Range)

For Dept = 1 To 3 Step 2
For MonthNum = 1 To 12
RangeName = MonthName(MonthNum, True) & "d" & Dept
If Not Intersect(target, Range(RangeName)) Is Nothing Then
DestRangeName = Dept & "d" & MonthName(MonthNum, True)
Range(RangeName).Copy _
Destination:=Sheets("Master Roster").Range(DestRangeName)
Exit Sub
End If
Next MonthNum
Next Dept
End Sub

for 2 & 4

Sub worksheet_change(ByVal target As Range)

For Dept = 2 To 4 Step 2
For MonthNum = 1 To 12
RangeName = MonthName(MonthNum, True) & "d" & Dept
If Not Intersect(target, Range(RangeName)) Is Nothing Then
DestRangeName = Dept & "d" & MonthName(MonthNum, True)
Range(RangeName).Copy _
Destination:=Sheets("Master Roster").Range(DestRangeName)
Exit Sub
End If
Next MonthNum
Next Dept
End Sub

Hi everyone, i'm new to Vba and i'm struggling. the story so far.
i have one workbook with 3 worksheets named - Master Roster, one named - dept

[quoted text clipped - 18 lines]

ferret