Dì problema per favore

Ciao
controlla questo codice per favore
Sottomacro()

Dim xRg come intervallo
Dim xCell come intervallo
Dim xRRg1 come intervallo
Dim xRRg2 come intervallo

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

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 finché

Dim xDC finché
Dim K quanto a lungo
Dim xC1 quanto lungo
Dim xFNum fino a quando

Imposta xAAWS = Fogli di lavoro("Foglio1") 'Ô?Ê ÇÕá?
Imposta xAWS = Fogli di lavoro ("Foglio 2") 'åÒ??å ÈÓÊå ÈäÏ?
Imposta xBWS = Fogli di lavoro ("Foglio 3") 'åÒ?äå ÊÈá?ÛÇÊ
Imposta xCWS = Fogli di lavoro("Foglio4") 'åÒ?äå ÇÏÇÔ
Imposta xWS = Fogli di lavoro("Foglio5") 'åÒ?äå ÛÑÝå ÞÕÇÈ?
Imposta xEWS = Fogli di lavoro("Foglio6") 'åÒ?äå ÍÞæÞ
Imposta xFWS = Fogli di lavoro ("Foglio 7") 'åÒ?äå ÏÑãÇä
Imposta xGWS = Fogli di lavoro("Foglio8") 'åÒ?äå ÓÝÑæÝæÞ ÇáÚÇÏå ãÇãæÑ?Ê ÏÇÎá ˜ÔæÑ
Imposta xHWS = Fogli di lavoro("Foglio9") 'åÒ?äå Ç?ÇÈ æÐåÇÈ
Imposta xIWS = Fogli di lavoro("Foglio10") 'ÂÈÜÜÜÜÜÜÜÏÇÑÎÜÜÜÜÜÜÇäå
Imposta xJWS = Fogli di lavoro("Foglio11") 'åÒíäå ÑÓäá æÙ?Ýå
Imposta xKWS = Fogli di lavoro("Foglio12") 'ÊäÙíÜÜÜÜÜÝ æ ÈÜÜÇÛÈÜÜÜÇäÜÜÜÜÜí
Imposta xLWS = Fogli di lavoro("Foglio13") 'åÒíäå ÌÔä æ ÐíÑÇí?
Imposta xMWS = Fogli di lavoro("Foglio14") 'åÒíäå ÓÊ ÊáÝä
Imposta xNWS = Fogli di lavoro ("Foglio 15") 'åÒíäå äæÔÊ ÇÝÒÇÑ
Imposta xPWS = Fogli di lavoro("Foglio16") 'åÒíäå ÈÇä˜í
Imposta xQWS = Fogli di lavoro("Foglio17") 'ÊÚãíÑ æ ä åÏÇÑí ÇËÜÜÜÜÜÜÇËå
Imposta xRWS = Fogli di lavoro("Foglio18") 'åÒ?äå ÊÚã?Ñ æä åÏÇÑí ÓÇÎÊãÇä
Imposta xSWS = Fogli di lavoro("Foglio19") 'åÒ?äå ÊÚã?Ñ æä åÏÇÑí ÊÇÓ?ÓÇÊ
Imposta xTWS = Fogli di lavoro("Foglio20") 'åÒ?äå ÊÚã?Ñ æÓÇÆØ äÞáíå
Imposta xUWS = Fogli di lavoro("Foglio21") 'åÒ?äå ÊÌå?ÒÇÊ ÑÇ?Çäå
Imposta xVWS = Fogli di lavoro("Foglio22") 'åÒ?äå ÓæÎÊ æÓÇÆØ äÞá?å
Imposta xWWS = Fogli di lavoro("Foglio23") 'åÒ?äå Íãá æäÞá æÊÎá?å æÈÇÑ ?Ñ?
Set xXWS = Fogli di lavoro("Foglio24") 'ÓÇíÑ åÒíäå åÇ
Imposta xYWS = Fogli di lavoro("Foglio25") 'åÒíäå ÍÞ ÕäÏÞÏÇÑ?
Imposta xZWS = Fogli di lavoro("Foglio26") 'åÒíäå áÈÇÓ

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

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

Imposta xRg = xAAWS.Range ("C1:C" e xAAR)
On Error Resume Next
Application.ScreenUpdating = False
Per K = 1 a xRg.Count

Se CStr(xRg(K).Value) = "imballaggio" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xAWS.Range("A" & xAR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xAR = xAR + 1

ElseIf CStr(xRg(K).Value) = "Pubblicità" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xBWS.Range("A" & xBR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xBR = xBR + 1

ElseIf CStr(xRg(K).Value) = "ricompensa" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xCWS.Range("A" & xCR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xCR = xCR + 1

ElseIf CStr(xRg(K).Value) = " Macelleria" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xWS.Range("A" & xDR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xDR = xDR + 1

ElseIf CStr(xRg(K).Value) = "Diritti" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xEWS.Range("A" & xER + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xER = xER + 1

ElseIf CStr(xRg(K).Value) = "trattamento" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xFWS.Range("A" & xFR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xFR = xFR + 1

ElseIf CStr(xRg(K).Value) = "Viaggio e missione" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xGWS.Range("A" & xGR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xGR = xGR + 1

ElseIf CStr(xRg(K).Value) = "Trasporto" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xHWS.Range("A" & xHR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xFC = xFC + 1

ElseIf CStr(xRg(K).Value) = "Juice House" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xIWS.Range("A" & xIR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xIR = xIR + 1

ElseIf CStr(xRg(K).Value) = " Personale di servizio" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xJWS.Range("A" & xJR + 1).InteraRiga
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xJR = xJR + 1

ElseIf CStr(xRg(K).Value) = "Pulizia e giardinaggio" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xKWS.Range("A" & xKR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xKR = xKR + 1

ElseIf CStr(xRg(K).Value) = " Celebrazione e ricevimento" Quindi
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xLWS.Range("A" & xLR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xLR = xLR + 1

ElseIf CStr(xRg(K).Value) = " *****" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xMWS.Range("A" & xMR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xMR = xMR + 1

ElseIf CStr(xRg(K).Value) = " Cancelleria" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xNWS.Range("A" & xNR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xNR = xNR + 1

ElseIf CStr(xRg(K).Value) = " Spese bancarie" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xPWS.Range("A" & xPR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xPR = xPR + 1

ElseIf CStr(xRg(K).Value) = " Riparazione e manutenzione di mobili" Then
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xQWS.Range("A" & xQR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xQR = xQR + 1

ElseIf CStr(xRg(K).Value) = "Manutenzione edificio" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xRWS.Range("A" & xRR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xRR = xRR + 1

ElseIf CStr(xRg(K).Value) = " Manutenzione struttura" Quindi
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xSWS.Range("A" & xSR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xSR = xSR + 1

ElseIf CStr(xRg(K).Value) = " Manutenzione del veicolo" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xTWS.Range("A" & xTR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xTR = xTR + 1

ElseIf CStr(xRg(K).Value) = "Apparecchiature informatiche" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xUWS.Range("A" & xUR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xUR = xUR + 1

ElseIf CStr(xRg(K).Value) = " Carburante veicolo" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xVWS.Range("A" & xVR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xVR = xVR + 1

ElseIf CStr(xRg(K).Value) = "Trasporto, scarico e carico" Quindi
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xWWS.Range("A" & xWR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xWR = xWR + 1

ElseIf CStr(xRg(K).Value) = " altri costi" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xXWS.Range("A" & xXR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xXR = xXR + 1

ElseIf CStr(xRg(K).Value) = " cassa " Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xYWS.Range("A" & xYR + 1).InteraRiga
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xYR = xYR + 1

ElseIf CStr(xRg(K).Value) = "vestito" Allora
Imposta xRRg1 = xRg(K).InteraRiga
Imposta xRRg2 = xZVWS.Range("A" & xZR + 1).EntreRow
Per xFNum = da 1 a xDC
xRRg2.Valore = xRRg1.Valore
Avanti xFNum
xRg(K).InteraRiga.Elimina
xZR = xZR + 1

End If
Il prossimo K
Application.ScreenUpdating = True
End Sub