Combine 2 macros into 1 Please.

Hello from Steved

Is it possible please to combine the 2 below macros into 1 macro. Thankyou.

Sub AddNameNewSheet2()
Dim CurrentSheetName As String
CurrentSheetName = ActiveSheet.Name

Sheets.Add

On Error Resume Next
Worksheets.Add.Name = "Waiheke"
Worksheets.Add.Name = "Panmure"
Worksheets.Add.Name = "Swanson"
Worksheets.Add.Name = "Orewa"
Worksheets.Add.Name = "Shore"
Worksheets.Add.Name = "Wiri"
Worksheets.Add.Name = "Papakura"
Worksheets.Add.Name = "Roskill"
Worksheets.Add.Name = "City"
Do Until Err.Number = 0
Err.Clear
Loop
On Error GoTo 0

Sheets(CurrentSheetName).Select

End Sub

Sub test4()
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("A2")
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

Steve

You can combine under 1 macro or have a 3rd macro that calls the other 2

Sub CallMacros()
Call AddNameNewSheet2
Call test4
End Sub

or


Sub MergedMacro()
Dim CurrentSheetName As String
Dim rng As Range
Dim WS As Worksheet

CurrentSheetName = ActiveSheet.Name

Sheets.Add

On Error Resume Next
Worksheets.Add.Name = "Waiheke"
Worksheets.Add.Name = "Panmure"
Worksheets.Add.Name = "Swanson"
Worksheets.Add.Name = "Orewa"
Worksheets.Add.Name = "Shore"
Worksheets.Add.Name = "Wiri"
Worksheets.Add.Name = "Papakura"
Worksheets.Add.Name = "Roskill"
Worksheets.Add.Name = "City"
Err.Clear
On Error GoTo 0

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("A2")
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

Hello Mudraker thanks.

"mudraker" wrote:

>
> Steve
>
> You can combine under 1 macro or have a 3rd macro that calls the other
> 2
>
> Sub CallMacros()
> Call AddNameNewSheet2
> Call test4
> End Sub
>
> or
>
>
> Sub MergedMacro()
> Dim CurrentSheetName As String
> Dim rng As Range
> Dim WS As Worksheet
>
> CurrentSheetName = ActiveSheet.Name
>
> Sheets.Add
>
> On Error Resume Next
> Worksheets.Add.Name = "Waiheke"
> Worksheets.Add.Name = "Panmure"
> Worksheets.Add.Name = "Swanson"
> Worksheets.Add.Name = "Orewa"
> Worksheets.Add.Name = "Shore"
> Worksheets.Add.Name = "Wiri"
> Worksheets.Add.Name = "Papakura"
> Worksheets.Add.Name = "Roskill"
> Worksheets.Add.Name = "City"
> Err.Clear
> On Error GoTo 0
>
> 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("A2")
> 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
>
>
> --
> mudraker
> ------------------------------------------------------------------------
> mudraker's Profile: http://www.excelforum.com/member.php...fo&userid=2473
> View this thread: http://www.excelforum.com/showthread...hreadid=397072
>
>