Option Explicit
Dim FX$
Private Sub Rpl()
ActiveSheet.UsedRange.Replace What:="BL Mobile1", Replacement:=FX, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
Sub NEWblmobile()
Const fmt As String * 7 = "0"" kgs"""
Dim Ws As Worksheet, I&, II&, III&, IV&, V&
Application.ScreenUpdating = 0
With ActiveWorkbook
For Each Ws In .Worksheets
FX = Ws.Name
Select Case -1
Case FX Like "BL Mobile*": I = I + 1
Case FX Like "PL Mobile*": II = II + 1
Case FX Like "Man Mobile*": III = III + 1
Case FX Like "Receipt*": IV = IV + 1
Case FX Like "SWB service*": V = V + 1
End Select
Next Ws
Application.EnableEvents = 0
.Worksheets("BL Mobile1").Copy after:=.Sheets(.Sheets.Count)
[C30:AV52] = "": [C30:AV52].HorizontalAlignment = xlLeft
[AX30:BF52] = "": [AX30:BF52].Activate: Selection.NumberFormat = fmt
FX = "BL Mobile" & 1 + I: ActiveSheet.Name = FX: [BS11] = FX
[BS12] = "PL Mobile" & II + 1: [BS13] = "Man Mobile" & III + 1
[BS14] = "Receipt" & IV + 1: [BS15] = "SWB service" & V + 1
[BM3] = 1 + I: [BM3].Select
.Worksheets("PL Mobile1").Copy after:=.Sheets(.Sheets.Count)
ActiveSheet.Name = "PL Mobile" & 1 + II: [A9:E42] = ""
[D9:E43].Activate: Selection.NumberFormat = fmt: Rpl
.Worksheets("Man Mobile1").Copy after:=.Sheets(.Sheets.Count)
With ActiveSheet
.Name = "Man Mobile" & 1 + III: .Unprotect
[D17:G18].HorizontalAlignment = xlLeft: [H15:H38].Activate
Selection.NumberFormat = fmt: Rpl: .Protect
End With
.Worksheets("Receipt1").Copy after:=.Sheets(.Sheets.Count)
ActiveSheet.Name = "Receipt" & 1 + IV: Rpl
.Worksheets("SWB service1").Copy after:=.Sheets(.Sheets.Count)
ActiveSheet.Name = "SWB service" & 1 + V: [AX30:BF52].Activate
Selection.NumberFormat = fmt: Rpl
Worksheets("BL Mobile" & 1 + I).Select
End With
Application.EnableEvents = -1
End Sub