To named Sheets

[Steved]

Hello from Steved

The below will copy to each named worksheet.

Can it be devoloped to copy City to City WorkSheet, Roskill to Roskill
Worksheet, Papakura to Papakura Worksheet, Wiri to Wiri Worksheet, Shore to
Shore Worksheet, Orewa to Orewa Worksheet, Swanson to Swanson Worksheet,
Waiheke to Waiheke Worksheet and Wellington to to Wellington Worksheet all
from the worksheet called Audit Report. Thankyou.

Sub test3()

Dim Source As Range
Dim WS As Worksheet
Set Source = Worksheets("Audit Report").Range("A6:Q255")
For Each WS In Worksheets
If WS.Name <> "Audit Report" Then
With Source
WS.Range("A6").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End If
Next
End Sub

 

[Bob Phillips]

What is City, Roskill, etc on Audit Report?

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Steved]

Hello Bob from Steved

Col A contains City, Roskill, etc
Col B Contains the Date
Col C Contains the Time
Col's D, F, to L and O, P Contains Numerials
Col's E, M, Q Contains Text

Starts at row 6 to 255

Hope this is helpful and Thankyou.

 

[Bob Phillips]

Hello Steved,

Here's a shot

Sub test3()
Dim rng As Range
Dim WS As Worksheet
For Each WS In Worksheets
If WS.Name <> "Audit Report" Then
Set rng = FilterData(WS.Name)
If Not rng Is Nothing Then
rng.Copy WS.Range("A1")
End If
End If
Next WS
End Sub

Private Function FilterData(sCity As String) As Range
Dim cRows As Long
Range("A1").EntireRow.Insert
Range("A1").FormulaR1C1 = "temp"
cRows = Cells(Rows.Count, "A").End(xlUp).Row
With Columns("A:A")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=sCity
End With
Set FilterData = Range("A2:A" &
cRows).SpecialCells(xlCellTypeVisible).EntireRow
Rows("1:1").Delete Shift:=xlUp
End Function


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Steved]

Thanks Bob Excellent.

Hello Steved,

Here's a shot

Sub test3()
Dim rng As Range
Dim WS As Worksheet
For Each WS In Worksheets
If WS.Name <> "Audit Report" Then
Set rng = FilterData(WS.Name)
If Not rng Is Nothing Then
rng.Copy WS.Range("A1")
End If
End If
Next WS
End Sub

Private Function FilterData(sCity As String) As Range
Dim cRows As Long
Range("A1").EntireRow.Insert
Range("A1").FormulaR1C1 = "temp"
cRows = Cells(Rows.Count, "A").End(xlUp).Row
With Columns("A:A")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=sCity
End With
Set FilterData = Range("A2:A" &
cRows).SpecialCells(xlCellTypeVisible).EntireRow
Rows("1:1").Delete Shift:=xlUp
End Function


--

HTH

RP
(remove nothere from the email address if mailing direct)