Say problem plz

Question

hello
check this code plz
Sub macro()

Dim xRg As Range
Dim xCell As Range
Dim xRRg1 As Range
Dim xRRg2 As Range

Dim xAAWS As Worksheet
Dim xAWS As Worksheet
Dim xBWS As Worksheet
Dim xCWS As Worksheet
Dim xDWS As Worksheet
Dim xEWS As Worksheet
Dim xFWS As Worksheet
Dim xGWS As Worksheet
Dim xHWS As Worksheet
Dim xIWS As Worksheet
Dim xJWS As Worksheet
Dim xKWS As Worksheet
Dim xLWS As Worksheet
Dim xMWS As Worksheet
Dim xNWS As Worksheet
Dim xPWS As Worksheet
Dim xQWS As Worksheet
Dim xRWS As Worksheet
Dim xSWS As Worksheet
Dim xTWS As Worksheet
Dim xUWS As Worksheet
Dim xVWS As Worksheet
Dim xWWS As Worksheet
Dim xXWS As Worksheet
Dim xYWS As Worksheet
Dim xZWS As Worksheet

Dim xAAR, xAR, xBR, xCR, xDR, xER, xFR, xGR, xHR, xIR, xJR, xKR, xLR, xMR, xNR, xPR, xQR, xRR, xSR, xTR, xUR, xVR, xWR, xXR, xYR, xZR As Long

Dim xDC As Long
Dim K As Long
Dim xC1 As Long
Dim xFNum As Long

Set xAAWS = Worksheets("Sheet1") 'Ô?Ê ÇÕá?
Set xAWS = Worksheets("Sheet2") 'åÒ??å ÈÓÊå ÈäÏ?
Set xBWS = Worksheets("Sheet3") 'åÒ?äå ÊÈá?ÛÇÊ
Set xCWS = Worksheets("Sheet4") 'åÒ?äå ÇÏÇÔ
Set xWS = Worksheets("Sheet5") 'åÒ?äå ÛÑÝå ÞÕÇÈ?
Set xEWS = Worksheets("Sheet6") 'åÒ?äå ÍÞæÞ
Set xFWS = Worksheets("Sheet7") 'åÒ?äå ÏÑãÇä
Set xGWS = Worksheets("Sheet8") 'åÒ?äå ÓÝÑæÝæÞ ÇáÚÇÏå ãÇãæÑ?Ê ÏÇÎá ˜ÔæÑ
Set xHWS = Worksheets("Sheet9") 'åÒ?äå Ç?ÇÈ æÐåÇÈ
Set xIWS = Worksheets("Sheet10") 'ÂÈÜÜÜÜÜÜÜÏÇÑÎÜÜÜÜÜÜÇäå
Set xJWS = Worksheets("Sheet11") 'åÒíäå ÑÓäá æÙ?Ýå
Set xKWS = Worksheets("Sheet12") 'ÊäÙíÜÜÜÜÜÝ æ ÈÜÜÇÛÈÜÜÜÇäÜÜÜÜÜí
Set xLWS = Worksheets("Sheet13") 'åÒíäå ÌÔä æÐíÑÇí?
Set xMWS = Worksheets("Sheet14") 'åÒíäå ÓÊ ÊáÝä
Set xNWS = Worksheets("Sheet15") 'åÒíäå äæÔÊ ÇÝÒÇÑ
Set xPWS = Worksheets("Sheet16") 'åÒíäå ÈÇä˜í
Set xQWS = Worksheets("Sheet17") 'ÊÚãíÑ æ äåÏÇÑí ÇËÜÜÜÜÜÜÇËå
Set xRWS = Worksheets("Sheet18") 'åÒ?äå ÊÚã?Ñ æäåÏÇÑí ÓÇÎÊãÇä
Set xSWS = Worksheets("Sheet19") 'åÒ?äå ÊÚã?Ñ æäåÏÇÑí ÊÇÓ?ÓÇÊ
Set xTWS = Worksheets("Sheet20") 'åÒ?äå ÊÚã?Ñ æÓÇÆØ äÞáíå
Set xUWS = Worksheets("Sheet21") 'åÒ?äå ÊÌå?ÒÇÊ ÑÇ?Çäå
Set xVWS = Worksheets("Sheet22") 'åÒ?äå ÓæÎÊ æÓÇÆØ äÞá?å
Set xWWS = Worksheets("Sheet23") 'åÒ?äå Íãá æäÞá æÊÎá?å æÈÇÑ?Ñ?
Set xXWS = Worksheets("Sheet24") 'ÓÇíÑ åÒíäå åÇ
Set xYWS = Worksheets("Sheet25") 'åÒíäå ÍÞ ÕäÏÞÏÇÑ?
Set xZWS = Worksheets("Sheet26") 'åÒíäå áÈÇÓ

xAAR = xAAWS.UsedRange.Rows.Count
xAR = xAWS.UsedRange.Rows.Count
xBR = xBWS.UsedRange.Rows.Count
xCR = xCWS.UsedRange.Rows.Count
xDR = xWS.UsedRange.Rows.Count
xER = xEWS.UsedRange.Rows.Count
xFR = xFWS.UsedRange.Rows.Count
xGR = xGWS.UsedRange.Rows.Count
xHR = xHWS.UsedRange.Rows.Count
xIR = xIWS.UsedRange.Rows.Count
xJR = xJWS.UsedRange.Rows.Count
xKR = xKWS.UsedRange.Rows.Count
xLR = xLWS.UsedRange.Rows.Count
xMR = xMWS.UsedRange.Rows.Count
xNR = xNWS.UsedRange.Rows.Count
xPR = xPWS.UsedRange.Rows.Count
xQR = xQWS.UsedRange.Rows.Count
xRR = xRWS.UsedRange.Rows.Count
xSR = xSWS.UsedRange.Rows.Count
xTR = xTWS.UsedRange.Rows.Count
xUR = xUWS.UsedRange.Rows.Count
xVR = xVWS.UsedRange.Rows.Count
xWR = xWWS.UsedRange.Rows.Count
xXR = xXWS.UsedRange.Rows.Count
xYR = xYWS.UsedRange.Rows.Count
xZR = xZWS.UsedRange.Rows.Count
xDC = xAAWS.UsedRange.Columns.Count

If xAR = 1 Then
If Application.WorksheetFunction.CountA(xAWS.UsedRange) = 0 Then xAR = 0
End If
If xBR = 1 Then
If Application.WorksheetFunction.CountA(xBWS.UsedRange) = 0 Then xBR = 0
End If
If xCR = 1 Then
If Application.WorksheetFunction.CountA(xCWS.UsedRange) = 0 Then xCR = 0
End If
If xDR = 1 Then
If Application.WorksheetFunction.CountA(xWS.UsedRange) = 0 Then xDR = 0
End If
If xER = 1 Then
If Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Then xER = 0
End If
If xFR = 1 Then
If Application.WorksheetFunction.CountA(xFWS.UsedRange) = 0 Then xFR = 0
End If
If xGR = 1 Then
If Application.WorksheetFunction.CountA(xGWS.UsedRange) = 0 Then xGR = 0
End If
If xHR = 1 Then
If Application.WorksheetFunction.CountA(xHWS.UsedRange) = 0 Then xHR = 0
End If
If xIR = 1 Then
If Application.WorksheetFunction.CountA(xIWS.UsedRange) = 0 Then xIR = 0
End If
If xJR = 1 Then
If Application.WorksheetFunction.CountA(xJWS.UsedRange) = 0 Then xJR = 0
End If
If xKR = 1 Then
If Application.WorksheetFunction.CountA(xKWS.UsedRange) = 0 Then xKR = 0
End If
If xLR = 1 Then
If Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Then xLR = 0
End If
If xMR = 1 Then
If Application.WorksheetFunction.CountA(xMWS.UsedRange) = 0 Then xMR = 0
End If
If xNR = 1 Then
If Application.WorksheetFunction.CountA(xNWS.UsedRange) = 0 Then xNR = 0
End If
If xPR = 1 Then
If Application.WorksheetFunction.CountA(xPWS.UsedRange) = 0 Then xPR = 0
End If
If xQR = 1 Then
If Application.WorksheetFunction.CountA(xQWS.UsedRange) = 0 Then xQR = 0
End If
If xRR = 1 Then
If Application.WorksheetFunction.CountA(xRWS.UsedRange) = 0 Then xRR = 0
End If
If xSR = 1 Then
If Application.WorksheetFunction.CountA(xSWS.UsedRange) = 0 Then xSR = 0
End If
If xTR = 1 Then
If Application.WorksheetFunction.CountA(xTWS.UsedRange) = 0 Then xTR = 0
End If
If xUR = 1 Then
If Application.WorksheetFunction.CountA(xUWS.UsedRange) = 0 Then xUR = 0
End If
If xVR = 1 Then
If Application.WorksheetFunction.CountA(xVWS.UsedRange) = 0 Then xVR = 0
End If
If xWR = 1 Then
If Application.WorksheetFunction.CountA(xWWS.UsedRange) = 0 Then xWR = 0
End If
If xXR = 1 Then
If Application.WorksheetFunction.CountA(xXWS.UsedRange) = 0 Then xXR = 0
End If
If xYR = 1 Then
If Application.WorksheetFunction.CountA(xYWS.UsedRange) = 0 Then xYR = 0
End If
If xZR = 1 Then
If Application.WorksheetFunction.CountA(xZWS.UsedRange) = 0 Then xZR = 0
End If

Set xRg = xAAWS.Range("C1:C" & xAAR)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count

If CStr(xRg(K).Value) = "packing" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xAWS.Range("A" & xAR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xAR = xAR + 1

ElseIf CStr(xRg(K).Value) = " Advertising" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xBWS.Range("A" & xBR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xBR = xBR + 1

ElseIf CStr(xRg(K).Value) = "reward" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xCWS.Range("A" & xCR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xCR = xCR + 1

ElseIf CStr(xRg(K).Value) = " Butcher shop" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xWS.Range("A" & xDR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xDR = xDR + 1

ElseIf CStr(xRg(K).Value) = " Rights" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xEWS.Range("A" & xER + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xER = xER + 1

ElseIf CStr(xRg(K).Value) = " treatment" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xFWS.Range("A" & xFR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xFR = xFR + 1

ElseIf CStr(xRg(K).Value) = " Travel and mission" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xGWS.Range("A" & xGR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xGR = xGR + 1

ElseIf CStr(xRg(K).Value) = " Transportation" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xHWS.Range("A" & xHR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xHR = xHR + 1

ElseIf CStr(xRg(K).Value) = " Juice House" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xIWS.Range("A" & xIR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xIR = xIR + 1

ElseIf CStr(xRg(K).Value) = " Duty personnel" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xJWS.Range("A" & xJR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xJR = xJR + 1

ElseIf CStr(xRg(K).Value) = " Cleaning and gardening" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xKWS.Range("A" & xKR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xKR = xKR + 1

ElseIf CStr(xRg(K).Value) = " Celebration and reception" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xLR = xLR + 1

ElseIf CStr(xRg(K).Value) = " *****" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xMWS.Range("A" & xMR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xMR = xMR + 1

ElseIf CStr(xRg(K).Value) = " Stationery" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xNWS.Range("A" & xNR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xNR = xNR + 1

ElseIf CStr(xRg(K).Value) = " Bank charges" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xPWS.Range("A" & xPR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xPR = xPR + 1

ElseIf CStr(xRg(K).Value) = " Repair and maintenance of furniture" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xQWS.Range("A" & xQR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xQR = xQR + 1

ElseIf CStr(xRg(K).Value) = " Building maintenance" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xRWS.Range("A" & xRR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xRR = xRR + 1

ElseIf CStr(xRg(K).Value) = " Facility maintenance" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xSWS.Range("A" & xSR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xSR = xSR + 1

ElseIf CStr(xRg(K).Value) = " Vehicle maintenance" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xTWS.Range("A" & xTR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xTR = xTR + 1

ElseIf CStr(xRg(K).Value) = " Computer equipment " Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xUWS.Range("A" & xUR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xUR = xUR + 1

ElseIf CStr(xRg(K).Value) = " Vehicle fuel" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xVWS.Range("A" & xVR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xVR = xVR + 1

ElseIf CStr(xRg(K).Value) = " Transportation, unloading and loading" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xWWS.Range("A" & xWR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xWR = xWR + 1

ElseIf CStr(xRg(K).Value) = " other costs" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xXWS.Range("A" & xXR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xXR = xXR + 1

ElseIf CStr(xRg(K).Value) = " cash desk " Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xYWS.Range("A" & xYR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xYR = xYR + 1

ElseIf CStr(xRg(K).Value) = "dress" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = xZVWS.Range("A" & xZR + 1).EntireRow
For xFNum = 1 To xDC
xRRg2.Value = xRRg1.Value
Next xFNum
xRg(K).EntireRow.Delete
xZR = xZR + 1

End If
Next K
Application.ScreenUpdating = True
End Sub