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

Combine 2 macros into 1 Please.
 

Steve

You can combine under 1 macro or have a 3rd macro that calls the othe
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 Functio

--
mudrake
-----------------------------------------------------------------------
mudraker's Profile: http://www.excelforum.com/member.php...nfo&userid=247
View this thread: http://www.excelforum.com/showthread.php?threadid=39707

Combine 2 macros into 1 Please.
 

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

Combine 2 macros into 1 Please.
 

I spent many hours looking for this.

Much thanks.
James

"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