Worksheet Looping not working for all the sheets

Hi All,

I am trying to run below Macro for several worksheets in a workbook (For an instance, lets assume 3 sheets)

Though the initial sorting part is getting executed for all the three worksheets but rest of code is not.

Please suggest what changes need to be carried out in the code below so as to make it worksheets friendly/usable.

Code :
----------------------------------------------------------------------------

Private Sub CommandButton1_Click()

'Active WorkSheets Calculation
Dim Ws_Count As Integer
Dim Q As Integer

Ws_Count = ActiveWorkbook.Worksheets.Count

'Loop to run through all worksheets
For Q = 1 To Ws_Count

MsgBox ActiveWorkbook.Worksheets(Q).Name

' Sorting of Data
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveWorkbook.Worksheets(Q).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(Q).Sort.SortFields.Add Key:=Range("B:B"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(Q).Sort.SortFields.Add Key:=Range("E:E"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(Q).Sort.SortFields.Add Key:=Range("F:F"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(Q).Sort.SortFields.Add Key:=Range("G:G"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(Q).Sort.SortFields.Add Key:=Range("D:D"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(Q).Sort
        .SetRange Range("A:G")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
' Sorting Ends

'------------Code works till here ------------

' Active Row Count
'RowCount = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row - 1
Dim RowCount As Long
RowCount = Range("A1").CurrentRegion.Rows.Count
'MsgBox "The number of rows is " & RowCount
' Row Count Ends

'Cell Count Variable Declaration And Initialization
Dim X As Integer, Y As Integer
Dim A As Integer, B As Integer
X = 2
Y = 2
A = 2
B = 5
'Declaration And Initialization Ends

'Sum Variable Declaration And Initialization
Dim Total1 As Double, Total2 As Double, TotalSum As Double
Total1 = 0
Total2 = 0
SumTotal = 0
'Declaration And Initialization Ends


' Data Reconcilation Start
For I = 1 To RowCount

' Empty Cell Check
If Cells(X, Y).Value <> "" Then

' Currency Check
If Cells(X, Y).Value = Cells(X + 1, Y) Then

'Abs Total Check
If Cells(A, B).Value = Cells(A + 1, B) Then

Total1 = Cells(A, 6).Value + Cells(A, 7).Value
Total2 = Cells(A + 1, 6).Value + Cells(A + 1, 7).Value
SumTotal = Total1 + Total2 + SumTotal
'MsgBox (Total1)
'MsgBox (Total2)
'MsgBox (SumTotal)
' Identifying Matched Rows
If SumTotal = 0 Then

'Variables of Marking Cells Declaration And Initialization
Dim M As Integer, N As Integer, P As Integer
M = A
N = B
'Declaration And Initialization Ends

'Row Marking
For J = 1 To RowCount
If Cells(M, N).Value = Cells(M + 1, B) Then
Cells(M + 1, 8).Value = "X"
Cells(M, 8).Value = "X"
M = M - 1
End If
Next J
'Row Marking Ends
End If
'Matched Row Identification Ends

Else
Total1 = 0
Total2 = 0
SumTotal = 0
End If
'Abs Value Check Ends

Else
Total1 = 0
Total2 = 0
SumTotal = 0
End If
'Currency Check Ends

' Cell Counter Increase
X = X + 1
A = A + 1
' Cell Counter Increase Ends

End If
'Empty Cell Check Ends

Next I
' Data Reconcilation Ends


' Cut Paste Procedure Starts

' Determining Where to Paste Reconciled Data
Columns("A:A").Select
    Selection.Find(What:="END", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
Dim D As Integer
D = ActiveCell.Row
' Determining Where to Paste Reconciled Data Ends

' Copy Paste Procedure Starts
For K = 2 To RowCount
If Cells(K, 8) = "X" Then
'MsgBox ("A" & K)
Range("A" & K & ":" & "G" & K).Select
Selection.Cut
Cells(D + 1, 1).Select
ActiveSheet.Paste
D = D + 1
End If
Next K
' Copy Paste Procedure Ends

'Delete Empty Rows
Dim S As Integer
S = 2
For K = 2 To RowCount
If Cells(S, 8) = "X" Then
Range("A" & S & ":" & "G" & S).Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Delete Shift:=xlUp
Else
S = S + 1
End If
Next K
'Delete Empty Rows Ends

Next Q
' Loop to run through all worksheets Ends

End Sub

--------------------------------------------------------------------