Copy Rows To desinated Sheet Please. But First Creating Them.

[Steved]

Hello from Steved

I need the below please to be to do the following

I have ten cities City, Roskill, Papakura, Wiri, Shore, Orewa, Swanson,
Panmure, Waiheke.

In Col A I have the cities.
Ok I start it in Row A6.
Each row is from Col A to Col Q to be copied to each worksheet.
I have 250 Rows of information.

Public Sub CopyRowsToSheetN()
Application.ScreenUpdating = False
Dim cell As Range
Dim rng As Range, oldSelection As Range
Dim wks As Worksheet, wksT As Worksheet
Set oldSelection = Selection
Set wks = ThisWorkbook.Worksheets("Data")
Set rng = Intersect(wks.Columns("A"), wks.UsedRange)
For Each cell In rng.Cells
If Len(cell.Text) > 0 Then
Set wksT = GetWorksheet(wks.Parent, "" & Left(cell.Text, 11))
cell.EntireRow.Copy wksT.Columns("A").Cells(cell.Row)
End If
Next cell
On Error Resume Next
For Each wksT In wks.Parent.Worksheets
wksT.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
Next
Application.Goto oldSelection
Application.ScreenUpdating = True
End Sub

Thankyou.

[Patrick Molloy]

your question is not clear.

You want to copy from sheet Data the range A6:Q255 to each worksheet

DIM Source as Range
DIM WS as Worksheet
SET Source = Worksheets("Data").Range("A6:Q255")
FOR EACH ws IN Worksheets
IF ws.Name <>"Data" THEN
WITH Source
ws.Range("A1").Resize(.Rows.Count,.Columns.Count).Value = .Value
END WITH
END IF
NEXT



"Steved" wrote:

> Hello from Steved
>
> I need the below please to be to do the following
>
> I have ten cities City, Roskill, Papakura, Wiri, Shore, Orewa, Swanson,
> Panmure, Waiheke.
>
> In Col A I have the cities.
> Ok I start it in Row A6.
> Each row is from Col A to Col Q to be copied to each worksheet.
> I have 250 Rows of information.
>
> Public Sub CopyRowsToSheetN()
> Application.ScreenUpdating = False
> Dim cell As Range
> Dim rng As Range, oldSelection As Range
> Dim wks As Worksheet, wksT As Worksheet
> Set oldSelection = Selection
> Set wks = ThisWorkbook.Worksheets("Data")
> Set rng = Intersect(wks.Columns("A"), wks.UsedRange)
> For Each cell In rng.Cells
> If Len(cell.Text) > 0 Then
> Set wksT = GetWorksheet(wks.Parent, "" & Left(cell.Text, 11))
> cell.EntireRow.Copy wksT.Columns("A").Cells(cell.Row)
> End If
> Next cell
> On Error Resume Next
> For Each wksT In wks.Parent.Worksheets
> wksT.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
> Next
> Application.Goto oldSelection
> Application.ScreenUpdating = True
> End Sub
>
> Thankyou.

[Steved]

Hello Patrick from Steved

Firstly Thankyou.

Ok I have a renamed Sheet1 and called it Data.

I have 9 cities City, Roskill, Papakura, Wiri, Shore, Orewa, Swanson,
Panmure, Waiheke.

On the worksheet called Data I would like it to insert worksheets with the
above Cities ie City , Roskill and so on then copy the value from the data
sheet.

Hopefully you can help me.

Thankyou.



"Patrick Molloy" wrote:

> your question is not clear.
>
> You want to copy from sheet Data the range A6:Q255 to each worksheet
>
> DIM Source as Range
> DIM WS as Worksheet
> SET Source = Worksheets("Data").Range("A6:Q255")
> FOR EACH ws IN Worksheets
> IF ws.Name <>"Data" THEN
> WITH Source
> ws.Range("A1").Resize(.Rows.Count,.Columns.Count).Value = .Value
> END WITH
> END IF
> NEXT
>
>
>
> "Steved" wrote:
>
> > Hello from Steved
> >
> > I need the below please to be to do the following
> >
> > I have ten cities City, Roskill, Papakura, Wiri, Shore, Orewa, Swanson,
> > Panmure, Waiheke.
> >
> > In Col A I have the cities.
> > Ok I start it in Row A6.
> > Each row is from Col A to Col Q to be copied to each worksheet.
> > I have 250 Rows of information.
> >
> > Public Sub CopyRowsToSheetN()
> > Application.ScreenUpdating = False
> > Dim cell As Range
> > Dim rng As Range, oldSelection As Range
> > Dim wks As Worksheet, wksT As Worksheet
> > Set oldSelection = Selection
> > Set wks = ThisWorkbook.Worksheets("Data")
> > Set rng = Intersect(wks.Columns("A"), wks.UsedRange)
> > For Each cell In rng.Cells
> > If Len(cell.Text) > 0 Then
> > Set wksT = GetWorksheet(wks.Parent, "" & Left(cell.Text, 11))
> > cell.EntireRow.Copy wksT.Columns("A").Cells(cell.Row)
> > End If
> > Next cell
> > On Error Resume Next
> > For Each wksT In wks.Parent.Worksheets
> > wksT.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
> > Next
> > Application.Goto oldSelection
> > Application.ScreenUpdating = True
> > End Sub
> >
> > Thankyou.

[Steved]

Hello Patrick from Steved

If you get to read this I have now a macro that will create the seperate
worksheets

Can your effort please Identify say city and put it in City worksheet,
Roskill into Roskill worksheet and so on.

Thankyou.

"Steved" wrote:

> Hello Patrick from Steved
>
> Firstly Thankyou.
>
> Ok I have a renamed Sheet1 and called it Data.
>
> I have 9 cities City, Roskill, Papakura, Wiri, Shore, Orewa, Swanson,
> Panmure, Waiheke.
>
> On the worksheet called Data I would like it to insert worksheets with the
> above Cities ie City , Roskill and so on then copy the value from the data
> sheet.
>
> Hopefully you can help me.
>
> Thankyou.
>
>
>
> "Patrick Molloy" wrote:
>
> > your question is not clear.
> >
> > You want to copy from sheet Data the range A6:Q255 to each worksheet
> >
> > DIM Source as Range
> > DIM WS as Worksheet
> > SET Source = Worksheets("Data").Range("A6:Q255")
> > FOR EACH ws IN Worksheets
> > IF ws.Name <>"Data" THEN
> > WITH Source
> > ws.Range("A1").Resize(.Rows.Count,.Columns.Count).Value = .Value
> > END WITH
> > END IF
> > NEXT
> >
> >
> >
> > "Steved" wrote:
> >
> > > Hello from Steved
> > >
> > > I need the below please to be to do the following
> > >
> > > I have ten cities City, Roskill, Papakura, Wiri, Shore, Orewa, Swanson,
> > > Panmure, Waiheke.
> > >
> > > In Col A I have the cities.
> > > Ok I start it in Row A6.
> > > Each row is from Col A to Col Q to be copied to each worksheet.
> > > I have 250 Rows of information.
> > >
> > > Public Sub CopyRowsToSheetN()
> > > Application.ScreenUpdating = False
> > > Dim cell As Range
> > > Dim rng As Range, oldSelection As Range
> > > Dim wks As Worksheet, wksT As Worksheet
> > > Set oldSelection = Selection
> > > Set wks = ThisWorkbook.Worksheets("Data")
> > > Set rng = Intersect(wks.Columns("A"), wks.UsedRange)
> > > For Each cell In rng.Cells
> > > If Len(cell.Text) > 0 Then
> > > Set wksT = GetWorksheet(wks.Parent, "" & Left(cell.Text, 11))
> > > cell.EntireRow.Copy wksT.Columns("A").Cells(cell.Row)
> > > End If
> > > Next cell
> > > On Error Resume Next
> > > For Each wksT In wks.Parent.Worksheets
> > > wksT.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
> > > Next
> > > Application.Goto oldSelection
> > > Application.ScreenUpdating = True
> > > End Sub
> > >
> > > Thankyou.