Run VBA Code of diffrent sheet Automaticly

[parscon]

I have 6 sheet . and also 6 VBA Code .

is there any code that cab be run for example : (Automaticly)that mean when the First VBA code will be done second VBA code will be start on second sheet .... .


Sheet A First VBA Code
Sheet B Second VBA Code
Sheet C Third VBA Code
Sheet D Fourth VBA Code
Sheet E Fifth VBA Code
Sheet F Sixth VBA Code


.....

if is it possible please help me .

[Bob Phillips]

Yes, simple call all 6 procedures from another procedure.

[parscon]

Could you please help me how can i do this ? have 6 diffrent sheet with 6 diffrent VBA code and want start from sheet A with VBA code 1 after that run VBA code 2 for sheet B and ... and it will be automaticly .

[Bob Phillips]

I cannot say it any differently than I already have. What does this code looke like?

[parscon]

my active sheet is A and i want when i run VBA and when it will be done go to another sheet and run another VBA code automaticlyand again for anoter sheet . that mean i just run 1 Micro and after taht will be automaticly .

hope you understand me .

Thank you .

[parscon]

That mean when the first vba done in sheet A i use Worksheets("B").Activate that mean show sheet b and also i have a vba for this sheet and i want to start automaticly . hope you understand me .

[parscon]

Also i need this VBA code to be run on sheet B- Sheet c-Sheet D- Sheet E- Sheet F .


Sub TEST()
Dim x As Long
Dim LastRow As Long
LastRow = Range("B65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("B1:B" & x), Range("B" & x).Text) > 1 Then
Range("B" & x).Delete Shift:=xlUp
End If
Next x
On Error Resume Next
Range(Cells(1, "B"), Cells(LastRow, "B")).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
On Error GoTo 0


Dim a As Range

With ActiveSheet

For Each a In ActiveSheet.UsedRange
a = Replace(a, " (", "(")
a = Replace(a, "(BLM)", ", ")
a = Replace(a, "POE", "")
a = Replace(a, "POE ", "")
a = Replace(a, "(POE LM)", "(LM), ")
a = Replace(a, "kerman)", "kerman), ")
a = Replace(a, "PCMN", "PCMS, ")
Next

Cells.Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


With Sheets("sheetFinal")
.Range(.Range("B1"), .Range("B65536").End(xlUp)).Copy
End With
Sheets("SRP-Final").[B65536].End(xlUp)(1).PasteSpecial Paste:=xlValues


Cells.Select
Selection.ClearContents
Range("A1").Select
End With
End Sub

[mdmackillop]

Untested, but you want something like this. Also, for your initial query, use sheet references properly and avoid working with ActiveSheet

Sub TEST()
Dim x As Long
Dim LastRow As Long

Dim arr(), sh

arr = Array("sheet B", "Sheet c", "Sheet D", "Sheet E", "Sheet F")

For Each sh In arr
Set ws = Sheets(sh)
With ws

LastRow = .Range("B65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(.Range("B1:B" & x), .Range("B" & x).Text) > 1 Then
.Range("B" & x).Delete Shift:=xlUp
End If
Next x
On Error Resume Next
Range(.Cells(1, "B"), .Cells(LastRow, "B")).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
On Error GoTo 0


Dim a As Range


For Each a In .UsedRange
a = Replace(a, " (", "(")
a = Replace(a, "(BLM)", ", ")
a = Replace(a, "POE", "")
a = Replace(a, "POE ", "")
a = Replace(a, "(POE LM)", "(LM), ")
a = Replace(a, "kerman)", "kerman), ")
a = Replace(a, "PCMN", "PCMS, ")
Next

.Cells.Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


With Sheets("sheetFinal")
.Range(.Range("B1"), .Range("B65536").End(xlUp)).Copy
End With
Sheets("SRP-Final").[B65536].End(xlUp)(1).PasteSpecial Paste:=xlValues


.Cells.ClearContents
End With
End Sub