Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,

Juarssien,

You could write a macro to step through the data and transfer it, but using
the autofilter function may be quicker and easier.

Select any of the heading cells on your summary sheet. Then select Data...
Filter... Autofilter...
Click on the drop down arrow for the Team ID column and select the team you
are interested in.
Mark the range of data and copy/paste it into the next sheet.
Repeat the process until you have the data parsed.

Regards...

ChristopherTri

"Jurassien" wrote:

Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,

ChristopherTri has offered up a viable solution and you may want to just use
it if there are not many teams involved. But if there are a lot of teams
involved, or if you're going to have to do this often then this code may help
you. Note that if you run this routine twice with the same information on
the Summary Page, then it is going to end up on the team sheets twice (and
again for each time you run it).

If you are going to have information added to the data on the Summary Page
and then need to move that to the existing team sheets, easiest thing to do
is first delete all existing team sheets and 'rebuild' them using this
process. It will even create the sheets for you as long as the entries in
column E are valid to use as sheet names. There are some Constants you can
change if your sheet layout changes, I think I've given them 'intuitive'
names, so changing them shouldn't be too difficult, I hope.

Sub MoveTeamEntries()
Const FirstRowWithTeamData = 2 ' row 1 is header row
Const TeamColumn = "E" ' column with team ID/Sheet names
Const SourceSheet = "Summary Page"
Const FirstColToCopy = "A"
Const LastColToCopy = "V"

Dim lastDataRow As Long
Dim destSheet As String ' hold name of destination sheeet
Dim destRow As Long ' row on dest sheet to put data into
Dim rowOffset As Long ' pointer to data
Dim whatToCopy As Range
Dim whereToPaste As Range
Dim testPageValue As Variant 'use to test for page presence

'find last used row on Summary Page
lastDataRow = Worksheets(SourceSheet).Range(TeamColumn _
& Rows.Count).End(xlUp).Row
'select Summary Page and cell at top of team list
Worksheets(SourceSheet).Select
Range(TeamColumn & "1").Select
'turn off screen updating for speed
Application.ScreenUpdating = False
For rowOffset = (FirstRowWithTeamData - 1) To lastDataRow - 1
'don't do anything if cell is empty
If Not IsEmpty(ActiveCell.Offset(rowOffset, 0)) Then
' create name of sheet to seek
destSheet = Trim(ActiveCell.Offset(rowOffset, 0))
If Len(destSheet) 0 Then ' have a name!
Set whatToCopy = Worksheets(SourceSheet). _
Range(ActiveSheet.Range(FirstColToCopy & rowOffset + 1) _
.Address & ":" & _
ActiveSheet.Range(LastColToCopy & rowOffset + 1).Address)
'test if destination sheet exists
On Error Resume Next
' any cell will do
testPageValue = Worksheets(destSheet).Range("A1")
If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
Worksheets(SourceSheet).Select ' back to proper sheet
End If
On Error GoTo 0
destRow = Worksheets(destSheet).Range(TeamColumn & _
Rows.Count).End(xlUp).Row
If Not (IsEmpty(Worksheets(destSheet).Range(TeamColumn & _
destRow))) Then
'only on new, or empty sheets
destRow = destRow + 1
End If
Set whereToPaste = Worksheets(destSheet).Range( _
Range(FirstColToCopy & destRow).Address & ":" & _
Range(LastColToCopy & destRow).Address)
whereToPaste.Value = whatToCopy.Value
End If ' test for sheet name
End If ' test for empty cell
Next ' rowOffset loop
Application.ScreenUpdating = True

End Sub


"Jurassien" wrote:

Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,

Indeed, this is what I have been doing. Considering the number of teams
within the reports, proceeding this way seems to be very time consuming.

Thanks,

"ChristopherTri" wrote:

Juarssien,

You could write a macro to step through the data and transfer it, but using
the autofilter function may be quicker and easier.

Select any of the heading cells on your summary sheet. Then select Data...
Filter... Autofilter...
Click on the drop down arrow for the Team ID column and select the team you
are interested in.
Mark the range of data and copy/paste it into the next sheet.
Repeat the process until you have the data parsed.

Regards...

ChristopherTri

"Jurassien" wrote:

Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,

Thanks alot for the routine that you wrote me. I m going to run it in couple
of hours and provide you with an update. Indeed, there are too many teams
involved and I have to run these reports on daily basis.

Thanks,

"JLatham" wrote:

ChristopherTri has offered up a viable solution and you may want to just use
it if there are not many teams involved. But if there are a lot of teams
involved, or if you're going to have to do this often then this code may help
you. Note that if you run this routine twice with the same information on
the Summary Page, then it is going to end up on the team sheets twice (and
again for each time you run it).

If you are going to have information added to the data on the Summary Page
and then need to move that to the existing team sheets, easiest thing to do
is first delete all existing team sheets and 'rebuild' them using this
process. It will even create the sheets for you as long as the entries in
column E are valid to use as sheet names. There are some Constants you can
change if your sheet layout changes, I think I've given them 'intuitive'
names, so changing them shouldn't be too difficult, I hope.

Sub MoveTeamEntries()
Const FirstRowWithTeamData = 2 ' row 1 is header row
Const TeamColumn = "E" ' column with team ID/Sheet names
Const SourceSheet = "Summary Page"
Const FirstColToCopy = "A"
Const LastColToCopy = "V"

Dim lastDataRow As Long
Dim destSheet As String ' hold name of destination sheeet
Dim destRow As Long ' row on dest sheet to put data into
Dim rowOffset As Long ' pointer to data
Dim whatToCopy As Range
Dim whereToPaste As Range
Dim testPageValue As Variant 'use to test for page presence

'find last used row on Summary Page
lastDataRow = Worksheets(SourceSheet).Range(TeamColumn _
& Rows.Count).End(xlUp).Row
'select Summary Page and cell at top of team list
Worksheets(SourceSheet).Select
Range(TeamColumn & "1").Select
'turn off screen updating for speed
Application.ScreenUpdating = False
For rowOffset = (FirstRowWithTeamData - 1) To lastDataRow - 1
'don't do anything if cell is empty
If Not IsEmpty(ActiveCell.Offset(rowOffset, 0)) Then
' create name of sheet to seek
destSheet = Trim(ActiveCell.Offset(rowOffset, 0))
If Len(destSheet) 0 Then ' have a name!
Set whatToCopy = Worksheets(SourceSheet). _
Range(ActiveSheet.Range(FirstColToCopy & rowOffset + 1) _
.Address & ":" & _
ActiveSheet.Range(LastColToCopy & rowOffset + 1).Address)
'test if destination sheet exists
On Error Resume Next
' any cell will do
testPageValue = Worksheets(destSheet).Range("A1")
If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
Worksheets(SourceSheet).Select ' back to proper sheet
End If
On Error GoTo 0
destRow = Worksheets(destSheet).Range(TeamColumn & _
Rows.Count).End(xlUp).Row
If Not (IsEmpty(Worksheets(destSheet).Range(TeamColumn & _
destRow))) Then
'only on new, or empty sheets
destRow = destRow + 1
End If
Set whereToPaste = Worksheets(destSheet).Range( _
Range(FirstColToCopy & destRow).Address & ":" & _
Range(LastColToCopy & destRow).Address)
whereToPaste.Value = whatToCopy.Value
End If ' test for sheet name
End If ' test for empty cell
Next ' rowOffset loop
Application.ScreenUpdating = True

End Sub


"Jurassien" wrote:

Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,

Hello,
I was able to compile the routine below; however, when I try to run the
macro with the report in question open (Data located on sheet1 (named Summary
Page)), I am getting the following error: "Visual basic error 400"
MsgBox Application.Worksheets("Sheet1").Range("E1").Value , vbOKOnly

Please help!
Thanks,

"JLatham" wrote:

ChristopherTri has offered up a viable solution and you may want to just use
it if there are not many teams involved. But if there are a lot of teams
involved, or if you're going to have to do this often then this code may help
you. Note that if you run this routine twice with the same information on
the Summary Page, then it is going to end up on the team sheets twice (and
again for each time you run it).

If you are going to have information added to the data on the Summary Page
and then need to move that to the existing team sheets, easiest thing to do
is first delete all existing team sheets and 'rebuild' them using this
process. It will even create the sheets for you as long as the entries in
column E are valid to use as sheet names. There are some Constants you can
change if your sheet layout changes, I think I've given them 'intuitive'
names, so changing them shouldn't be too difficult, I hope.

Sub MoveTeamEntries()
Const FirstRowWithTeamData = 2 ' row 1 is header row
Const TeamColumn = "E" ' column with team ID/Sheet names
Const SourceSheet = "Summary Page"
Const FirstColToCopy = "A"
Const LastColToCopy = "V"

Dim lastDataRow As Long
Dim destSheet As String ' hold name of destination sheeet
Dim destRow As Long ' row on dest sheet to put data into
Dim rowOffset As Long ' pointer to data
Dim whatToCopy As Range
Dim whereToPaste As Range
Dim testPageValue As Variant 'use to test for page presence

'find last used row on Summary Page
lastDataRow = Worksheets(SourceSheet).Range(TeamColumn _
& Rows.Count).End(xlUp).Row
'select Summary Page and cell at top of team list
Worksheets(SourceSheet).Select
Range(TeamColumn & "1").Select
'turn off screen updating for speed
Application.ScreenUpdating = False
For rowOffset = (FirstRowWithTeamData - 1) To lastDataRow - 1
'don't do anything if cell is empty
If Not IsEmpty(ActiveCell.Offset(rowOffset, 0)) Then
' create name of sheet to seek
destSheet = Trim(ActiveCell.Offset(rowOffset, 0))
If Len(destSheet) 0 Then ' have a name!
Set whatToCopy = Worksheets(SourceSheet). _
Range(ActiveSheet.Range(FirstColToCopy & rowOffset + 1) _
.Address & ":" & _
ActiveSheet.Range(LastColToCopy & rowOffset + 1).Address)
'test if destination sheet exists
On Error Resume Next
' any cell will do
testPageValue = Worksheets(destSheet).Range("A1")
If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
Worksheets(SourceSheet).Select ' back to proper sheet
End If
On Error GoTo 0
destRow = Worksheets(destSheet).Range(TeamColumn & _
Rows.Count).End(xlUp).Row
If Not (IsEmpty(Worksheets(destSheet).Range(TeamColumn & _
destRow))) Then
'only on new, or empty sheets
destRow = destRow + 1
End If
Set whereToPaste = Worksheets(destSheet).Range( _
Range(FirstColToCopy & destRow).Address & ":" & _
Range(LastColToCopy & destRow).Address)
whereToPaste.Value = whatToCopy.Value
End If ' test for sheet name
End If ' test for empty cell
Next ' rowOffset loop
Application.ScreenUpdating = True

End Sub


"Jurassien" wrote:

Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,

Well, as written that routine should never even look in E1, plus there is no
code that even has a MsgBox statement in it.

You say that the the "Data located on sheet1 named Summary Page..." what is
the name on the sheet's tab? is it Sheet1 or is it Summary Page. This code
is written presuming that the name on the tab is "Summary Page". If it says
"Sheet1" then change the Const SourceSheet statement to read
Const SourceSheet = "Sheet1"

Also, notice down there where I put in a comment:
'can fail if destSheet is not a valid sheet name!
All the entries in your column E must be something that could be used as a
sheet name without creating an error (i.e. you should be able to name a sheet
tab with those entries). Also, I didn't cover the possibility that your
entries in column E might have a space in the middle of them, so they should
not.

Actually, I'm thinking the code is failing in some other routine somewhere?

If you're still really confused after all of that, attach the workbook to an
email and send it to (remove spaces) HelpFrom @ jlathamsite.com
and I'll take a closer look at it.
"Jurassien" wrote:

Hello,
I was able to compile the routine below; however, when I try to run the
macro with the report in question open (Data located on sheet1 (named Summary
Page)), I am getting the following error: "Visual basic error 400"
MsgBox Application.Worksheets("Sheet1").Range("E1").Value , vbOKOnly

Please help!
Thanks,

"JLatham" wrote:

ChristopherTri has offered up a viable solution and you may want to just use
it if there are not many teams involved. But if there are a lot of teams
involved, or if you're going to have to do this often then this code may help
you. Note that if you run this routine twice with the same information on
the Summary Page, then it is going to end up on the team sheets twice (and
again for each time you run it).

If you are going to have information added to the data on the Summary Page
and then need to move that to the existing team sheets, easiest thing to do
is first delete all existing team sheets and 'rebuild' them using this
process. It will even create the sheets for you as long as the entries in
column E are valid to use as sheet names. There are some Constants you can
change if your sheet layout changes, I think I've given them 'intuitive'
names, so changing them shouldn't be too difficult, I hope.

Sub MoveTeamEntries()
Const FirstRowWithTeamData = 2 ' row 1 is header row
Const TeamColumn = "E" ' column with team ID/Sheet names
Const SourceSheet = "Summary Page"
Const FirstColToCopy = "A"
Const LastColToCopy = "V"

Dim lastDataRow As Long
Dim destSheet As String ' hold name of destination sheeet
Dim destRow As Long ' row on dest sheet to put data into
Dim rowOffset As Long ' pointer to data
Dim whatToCopy As Range
Dim whereToPaste As Range
Dim testPageValue As Variant 'use to test for page presence

'find last used row on Summary Page
lastDataRow = Worksheets(SourceSheet).Range(TeamColumn _
& Rows.Count).End(xlUp).Row
'select Summary Page and cell at top of team list
Worksheets(SourceSheet).Select
Range(TeamColumn & "1").Select
'turn off screen updating for speed
Application.ScreenUpdating = False
For rowOffset = (FirstRowWithTeamData - 1) To lastDataRow - 1
'don't do anything if cell is empty
If Not IsEmpty(ActiveCell.Offset(rowOffset, 0)) Then
' create name of sheet to seek
destSheet = Trim(ActiveCell.Offset(rowOffset, 0))
If Len(destSheet) 0 Then ' have a name!
Set whatToCopy = Worksheets(SourceSheet). _
Range(ActiveSheet.Range(FirstColToCopy & rowOffset + 1) _
.Address & ":" & _
ActiveSheet.Range(LastColToCopy & rowOffset + 1).Address)
'test if destination sheet exists
On Error Resume Next
' any cell will do
testPageValue = Worksheets(destSheet).Range("A1")
If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
Worksheets(SourceSheet).Select ' back to proper sheet
End If
On Error GoTo 0
destRow = Worksheets(destSheet).Range(TeamColumn & _
Rows.Count).End(xlUp).Row
If Not (IsEmpty(Worksheets(destSheet).Range(TeamColumn & _
destRow))) Then
'only on new, or empty sheets
destRow = destRow + 1
End If
Set whereToPaste = Worksheets(destSheet).Range( _
Range(FirstColToCopy & destRow).Address & ":" & _
Range(LastColToCopy & destRow).Address)
whereToPaste.Value = whatToCopy.Value
End If ' test for sheet name
End If ' test for empty cell
Next ' rowOffset loop
Application.ScreenUpdating = True

End Sub


"Jurassien" wrote:

Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,

Hello,

I can get it working only if I copy the source file ( Summary Page which is
in another workbook) to the spreadsheet containing the macro routine. Also I
would like to have the header on each of the new sheets. I have tried to
change Const FirstRowWithTeamData = 1, but it has generated the same info
without header.
I will email you the macro form along with the spreadsheet containing the
report in question shortly.

I would like to be able to open the macro and run the report containing the
spreadsheet separately like I usually do with others macro. Once again thank
you for your tremendous helps. I have been working on this issue for about 3
months.


"JLatham" wrote:

Well, as written that routine should never even look in E1, plus there is no
code that even has a MsgBox statement in it.

You say that the the "Data located on sheet1 named Summary Page..." what is
the name on the sheet's tab? is it Sheet1 or is it Summary Page. This code
is written presuming that the name on the tab is "Summary Page". If it says
"Sheet1" then change the Const SourceSheet statement to read
Const SourceSheet = "Sheet1"

Also, notice down there where I put in a comment:
'can fail if destSheet is not a valid sheet name!
All the entries in your column E must be something that could be used as a
sheet name without creating an error (i.e. you should be able to name a sheet
tab with those entries). Also, I didn't cover the possibility that your
entries in column E might have a space in the middle of them, so they should
not.

Actually, I'm thinking the code is failing in some other routine somewhere?

If you're still really confused after all of that, attach the workbook to an
email and send it to (remove spaces) HelpFrom @ jlathamsite.com
and I'll take a closer look at it.
"Jurassien" wrote:

Hello,
I was able to compile the routine below; however, when I try to run the
macro with the report in question open (Data located on sheet1 (named Summary
Page)), I am getting the following error: "Visual basic error 400"
MsgBox Application.Worksheets("Sheet1").Range("E1").Value , vbOKOnly

Please help!
Thanks,

"JLatham" wrote:

ChristopherTri has offered up a viable solution and you may want to just use
it if there are not many teams involved. But if there are a lot of teams
involved, or if you're going to have to do this often then this code may help
you. Note that if you run this routine twice with the same information on
the Summary Page, then it is going to end up on the team sheets twice (and
again for each time you run it).

If you are going to have information added to the data on the Summary Page
and then need to move that to the existing team sheets, easiest thing to do
is first delete all existing team sheets and 'rebuild' them using this
process. It will even create the sheets for you as long as the entries in
column E are valid to use as sheet names. There are some Constants you can
change if your sheet layout changes, I think I've given them 'intuitive'
names, so changing them shouldn't be too difficult, I hope.

Sub MoveTeamEntries()
Const FirstRowWithTeamData = 2 ' row 1 is header row
Const TeamColumn = "E" ' column with team ID/Sheet names
Const SourceSheet = "Summary Page"
Const FirstColToCopy = "A"
Const LastColToCopy = "V"

Dim lastDataRow As Long
Dim destSheet As String ' hold name of destination sheeet
Dim destRow As Long ' row on dest sheet to put data into
Dim rowOffset As Long ' pointer to data
Dim whatToCopy As Range
Dim whereToPaste As Range
Dim testPageValue As Variant 'use to test for page presence

'find last used row on Summary Page
lastDataRow = Worksheets(SourceSheet).Range(TeamColumn _
& Rows.Count).End(xlUp).Row
'select Summary Page and cell at top of team list
Worksheets(SourceSheet).Select
Range(TeamColumn & "1").Select
'turn off screen updating for speed
Application.ScreenUpdating = False
For rowOffset = (FirstRowWithTeamData - 1) To lastDataRow - 1
'don't do anything if cell is empty
If Not IsEmpty(ActiveCell.Offset(rowOffset, 0)) Then
' create name of sheet to seek
destSheet = Trim(ActiveCell.Offset(rowOffset, 0))
If Len(destSheet) 0 Then ' have a name!
Set whatToCopy = Worksheets(SourceSheet). _
Range(ActiveSheet.Range(FirstColToCopy & rowOffset + 1) _
.Address & ":" & _
ActiveSheet.Range(LastColToCopy & rowOffset + 1).Address)
'test if destination sheet exists
On Error Resume Next
' any cell will do
testPageValue = Worksheets(destSheet).Range("A1")
If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
Worksheets(SourceSheet).Select ' back to proper sheet
End If
On Error GoTo 0
destRow = Worksheets(destSheet).Range(TeamColumn & _
Rows.Count).End(xlUp).Row
If Not (IsEmpty(Worksheets(destSheet).Range(TeamColumn & _
destRow))) Then
'only on new, or empty sheets
destRow = destRow + 1
End If
Set whereToPaste = Worksheets(destSheet).Range( _
Range(FirstColToCopy & destRow).Address & ":" & _
Range(LastColToCopy & destRow).Address)
whereToPaste.Value = whatToCopy.Value
End If ' test for sheet name
End If ' test for empty cell
Next ' rowOffset loop
Application.ScreenUpdating = True

End Sub


"Jurassien" wrote:

Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,

Hi

Now I can run the macro without moving data from the original workbook
without copy & paste. I had to save the routine to the module. My main
concern now is I want to have the header from the summary page workbook on
each team created. Having the header will make the report easy to understand.

Thanks,

"Jurassien" wrote:

Hello,

I can get it working only if I copy the source file ( Summary Page which is
in another workbook) to the spreadsheet containing the macro routine. Also I
would like to have the header on each of the new sheets. I have tried to
change Const FirstRowWithTeamData = 1, but it has generated the same info
without header.
I will email you the macro form along with the spreadsheet containing the
report in question shortly.

I would like to be able to open the macro and run the report containing the
spreadsheet separately like I usually do with others macro. Once again thank
you for your tremendous helps. I have been working on this issue for about 3
months.


"JLatham" wrote:

Well, as written that routine should never even look in E1, plus there is no
code that even has a MsgBox statement in it.

You say that the the "Data located on sheet1 named Summary Page..." what is
the name on the sheet's tab? is it Sheet1 or is it Summary Page. This code
is written presuming that the name on the tab is "Summary Page". If it says
"Sheet1" then change the Const SourceSheet statement to read
Const SourceSheet = "Sheet1"

Also, notice down there where I put in a comment:
'can fail if destSheet is not a valid sheet name!
All the entries in your column E must be something that could be used as a
sheet name without creating an error (i.e. you should be able to name a sheet
tab with those entries). Also, I didn't cover the possibility that your
entries in column E might have a space in the middle of them, so they should
not.

Actually, I'm thinking the code is failing in some other routine somewhere?

If you're still really confused after all of that, attach the workbook to an
email and send it to (remove spaces) HelpFrom @ jlathamsite.com
and I'll take a closer look at it.
"Jurassien" wrote:

Hello,
I was able to compile the routine below; however, when I try to run the
macro with the report in question open (Data located on sheet1 (named Summary
Page)), I am getting the following error: "Visual basic error 400"
MsgBox Application.Worksheets("Sheet1").Range("E1").Value , vbOKOnly

Please help!
Thanks,

"JLatham" wrote:

ChristopherTri has offered up a viable solution and you may want to just use
it if there are not many teams involved. But if there are a lot of teams
involved, or if you're going to have to do this often then this code may help
you. Note that if you run this routine twice with the same information on
the Summary Page, then it is going to end up on the team sheets twice (and
again for each time you run it).

If you are going to have information added to the data on the Summary Page
and then need to move that to the existing team sheets, easiest thing to do
is first delete all existing team sheets and 'rebuild' them using this
process. It will even create the sheets for you as long as the entries in
column E are valid to use as sheet names. There are some Constants you can
change if your sheet layout changes, I think I've given them 'intuitive'
names, so changing them shouldn't be too difficult, I hope.

Sub MoveTeamEntries()
Const FirstRowWithTeamData = 2 ' row 1 is header row
Const TeamColumn = "E" ' column with team ID/Sheet names
Const SourceSheet = "Summary Page"
Const FirstColToCopy = "A"
Const LastColToCopy = "V"

Dim lastDataRow As Long
Dim destSheet As String ' hold name of destination sheeet
Dim destRow As Long ' row on dest sheet to put data into
Dim rowOffset As Long ' pointer to data
Dim whatToCopy As Range
Dim whereToPaste As Range
Dim testPageValue As Variant 'use to test for page presence

'find last used row on Summary Page
lastDataRow = Worksheets(SourceSheet).Range(TeamColumn _
& Rows.Count).End(xlUp).Row
'select Summary Page and cell at top of team list
Worksheets(SourceSheet).Select
Range(TeamColumn & "1").Select
'turn off screen updating for speed
Application.ScreenUpdating = False
For rowOffset = (FirstRowWithTeamData - 1) To lastDataRow - 1
'don't do anything if cell is empty
If Not IsEmpty(ActiveCell.Offset(rowOffset, 0)) Then
' create name of sheet to seek
destSheet = Trim(ActiveCell.Offset(rowOffset, 0))
If Len(destSheet) 0 Then ' have a name!
Set whatToCopy = Worksheets(SourceSheet). _
Range(ActiveSheet.Range(FirstColToCopy & rowOffset + 1) _
.Address & ":" & _
ActiveSheet.Range(LastColToCopy & rowOffset + 1).Address)
'test if destination sheet exists
On Error Resume Next
' any cell will do
testPageValue = Worksheets(destSheet).Range("A1")
If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
Worksheets(SourceSheet).Select ' back to proper sheet
End If
On Error GoTo 0
destRow = Worksheets(destSheet).Range(TeamColumn & _
Rows.Count).End(xlUp).Row
If Not (IsEmpty(Worksheets(destSheet).Range(TeamColumn & _
destRow))) Then
'only on new, or empty sheets
destRow = destRow + 1
End If
Set whereToPaste = Worksheets(destSheet).Range( _
Range(FirstColToCopy & destRow).Address & ":" & _
Range(LastColToCopy & destRow).Address)
whereToPaste.Value = whatToCopy.Value
End If ' test for sheet name
End If ' test for empty cell
Next ' rowOffset loop
Application.ScreenUpdating = True

End Sub


"Jurassien" wrote:

Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,

Glad you got it working.

Here's how to modify that code to copy the contents of A1:V1 to the new
sheets as they are created: Need a new variable up in the Dim... statements:

Dim tempRange as Range

then the If Err < 0 section needs to be replaced with this:

If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
Set tempRange = Worksheets(SourceSheet). _
Range(FirstColToCopy & "1:" & LastColToCopy & "1")
Set wheretopaste = Worksheets(destSheet). _
Range(FirstColToCopy & "1:" & LastColToCopy & "1")
wheretopaste.Value = tempRange.Value
Worksheets(SourceSheet).Select ' back to proper sheet
End If

Or....
Here is the entire routine with the changes already in it, just replace what
you have with it:

Sub MoveTeamEntries()
Const FirstRowWithTeamData = 2 ' row 1 is header row
Const TeamColumn = "E" ' column with team ID/Sheet names
Const SourceSheet = "Summary Page"
Const FirstColToCopy = "A"
Const LastColToCopy = "V"

Dim lastDataRow As Long
Dim destSheet As String ' hold name of destination sheeet
Dim destRow As Long ' row on dest sheet to put data into
Dim rowOffset As Long ' pointer to data
Dim whatToCopy As Range
Dim wheretopaste As Range
Dim testPageValue As Variant 'use to test for page presence
Dim tempRange As Range ' for use during new sheet insertions

'find last used row on Summary Page
lastDataRow = Worksheets(SourceSheet).Range(TeamColumn _
& Rows.Count).End(xlUp).Row
'select Summary Page and cell at top of team list
Worksheets(SourceSheet).Select
Range(TeamColumn & "1").Select
'turn off screen updating for speed
Application.ScreenUpdating = False
For rowOffset = (FirstRowWithTeamData - 1) To lastDataRow - 1
'don't do anything if cell is empty
If Not IsEmpty(ActiveCell.Offset(rowOffset, 0)) Then
' create name of sheet to seek
destSheet = Trim(ActiveCell.Offset(rowOffset, 0))
If Len(destSheet) 0 Then ' have a name!
Set whatToCopy = Worksheets(SourceSheet). _
Range(ActiveSheet.Range(FirstColToCopy & rowOffset + 1) _
.Address & ":" & _
ActiveSheet.Range(LastColToCopy & rowOffset + 1).Address)
'test if destination sheet exists
On Error Resume Next
' any cell will do
testPageValue = Worksheets(destSheet).Range("A1")
If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
'added to move header info to new sheets
Set tempRange = Worksheets(SourceSheet). _
Range(FirstColToCopy & "1:" & LastColToCopy & "1")
Set wheretopaste = Worksheets(destSheet). _
Range(FirstColToCopy & "1:" & LastColToCopy & "1")
wheretopaste.Value = tempRange.Value
Worksheets(SourceSheet).Select ' back to proper sheet
End If
On Error GoTo 0
destRow = Worksheets(destSheet).Range(TeamColumn & _
Rows.Count).End(xlUp).Row
If Not (IsEmpty(Worksheets(destSheet).Range(TeamColumn & _
destRow))) Then
'only on new, or empty sheets
destRow = destRow + 1
End If
Set wheretopaste = Worksheets(destSheet).Range( _
Range(FirstColToCopy & destRow).Address & ":" & _
Range(LastColToCopy & destRow).Address)
wheretopaste.Value = whatToCopy.Value
End If ' test for sheet name
End If ' test for empty cell
Next ' rowOffset loop
Application.ScreenUpdating = True

End Sub



"Jurassien" wrote:

Hi

Now I can run the macro without moving data from the original workbook
without copy & paste. I had to save the routine to the module. My main
concern now is I want to have the header from the summary page workbook on
each team created. Having the header will make the report easy to understand.

Thanks,

"Jurassien" wrote:

Hello,

I can get it working only if I copy the source file ( Summary Page which is
in another workbook) to the spreadsheet containing the macro routine. Also I
would like to have the header on each of the new sheets. I have tried to
change Const FirstRowWithTeamData = 1, but it has generated the same info
without header.
I will email you the macro form along with the spreadsheet containing the
report in question shortly.

I would like to be able to open the macro and run the report containing the
spreadsheet separately like I usually do with others macro. Once again thank
you for your tremendous helps. I have been working on this issue for about 3
months.


"JLatham" wrote:

Well, as written that routine should never even look in E1, plus there is no
code that even has a MsgBox statement in it.

You say that the the "Data located on sheet1 named Summary Page..." what is
the name on the sheet's tab? is it Sheet1 or is it Summary Page. This code
is written presuming that the name on the tab is "Summary Page". If it says
"Sheet1" then change the Const SourceSheet statement to read
Const SourceSheet = "Sheet1"

Also, notice down there where I put in a comment:
'can fail if destSheet is not a valid sheet name!
All the entries in your column E must be something that could be used as a
sheet name without creating an error (i.e. you should be able to name a sheet
tab with those entries). Also, I didn't cover the possibility that your
entries in column E might have a space in the middle of them, so they should
not.

Actually, I'm thinking the code is failing in some other routine somewhere?

If you're still really confused after all of that, attach the workbook to an
email and send it to (remove spaces) HelpFrom @ jlathamsite.com
and I'll take a closer look at it.
"Jurassien" wrote:

Hello,
I was able to compile the routine below; however, when I try to run the
macro with the report in question open (Data located on sheet1 (named Summary
Page)), I am getting the following error: "Visual basic error 400"
MsgBox Application.Worksheets("Sheet1").Range("E1").Value , vbOKOnly

Please help!
Thanks,

"JLatham" wrote:

ChristopherTri has offered up a viable solution and you may want to just use
it if there are not many teams involved. But if there are a lot of teams
involved, or if you're going to have to do this often then this code may help
you. Note that if you run this routine twice with the same information on
the Summary Page, then it is going to end up on the team sheets twice (and
again for each time you run it).

If you are going to have information added to the data on the Summary Page
and then need to move that to the existing team sheets, easiest thing to do
is first delete all existing team sheets and 'rebuild' them using this
process. It will even create the sheets for you as long as the entries in
column E are valid to use as sheet names. There are some Constants you can
change if your sheet layout changes, I think I've given them 'intuitive'
names, so changing them shouldn't be too difficult, I hope.

Sub MoveTeamEntries()
Const FirstRowWithTeamData = 2 ' row 1 is header row
Const TeamColumn = "E" ' column with team ID/Sheet names
Const SourceSheet = "Summary Page"
Const FirstColToCopy = "A"
Const LastColToCopy = "V"

Dim lastDataRow As Long
Dim destSheet As String ' hold name of destination sheeet
Dim destRow As Long ' row on dest sheet to put data into
Dim rowOffset As Long ' pointer to data
Dim whatToCopy As Range
Dim whereToPaste As Range
Dim testPageValue As Variant 'use to test for page presence

'find last used row on Summary Page
lastDataRow = Worksheets(SourceSheet).Range(TeamColumn _
& Rows.Count).End(xlUp).Row
'select Summary Page and cell at top of team list
Worksheets(SourceSheet).Select
Range(TeamColumn & "1").Select
'turn off screen updating for speed
Application.ScreenUpdating = False
For rowOffset = (FirstRowWithTeamData - 1) To lastDataRow - 1
'don't do anything if cell is empty
If Not IsEmpty(ActiveCell.Offset(rowOffset, 0)) Then
' create name of sheet to seek
destSheet = Trim(ActiveCell.Offset(rowOffset, 0))
If Len(destSheet) 0 Then ' have a name!
Set whatToCopy = Worksheets(SourceSheet). _
Range(ActiveSheet.Range(FirstColToCopy & rowOffset + 1) _
.Address & ":" & _
ActiveSheet.Range(LastColToCopy & rowOffset + 1).Address)
'test if destination sheet exists
On Error Resume Next
' any cell will do
testPageValue = Worksheets(destSheet).Range("A1")
If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
Worksheets(SourceSheet).Select ' back to proper sheet
End If
On Error GoTo 0
destRow = Worksheets(destSheet).Range(TeamColumn & _
Rows.Count).End(xlUp).Row
If Not (IsEmpty(Worksheets(destSheet).Range(TeamColumn & _
destRow))) Then
'only on new, or empty sheets
destRow = destRow + 1
End If
Set whereToPaste = Worksheets(destSheet).Range( _
Range(FirstColToCopy & destRow).Address & ":" & _
Range(LastColToCopy & destRow).Address)
whereToPaste.Value = whatToCopy.Value
End If ' test for sheet name
End If ' test for empty cell
Next ' rowOffset loop
Application.ScreenUpdating = True

End Sub


"Jurassien" wrote:

Hello,

I desperately need help on creating a macro script that will be moving data
from the summary sheet within a workbook to the next sheet based on team ID
(column E).

Something like if cell E3 = 000 then copy the entire row to sheet 000 else
look for another Team ID within the same column (E) and do the same process
(sheet 001) so on.


I currently do it manually and it seems to be very time consuming. I was
wondering if the script below can be changed to fit what I am trying to
accomplish. Any helps would be greatly appreciated.

Sub DoCopy()
Dim szRange As String
szRange = "E1:V200"

Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-000").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-001").Range(szRange)
Worksheets("Summary Page").Range(szRange).Copy
Destination:=Worksheets("Team-002").Range(szRange)

End Sub



Thanks,