hallo
controleer deze code plz
Submacro()
Dim xRg als bereik
Dim xCell als bereik
Dim xRRg1 als bereik
Dim xRRg2 als bereik
Dim xAAWS als werkblad
Dim xAWS als werkblad
Dim xBWS als werkblad
Dim xCWS als werkblad
Dim xDWS als werkblad
Dim xEWS als werkblad
Dim xFWS als werkblad
Dim xGWS als werkblad
Dim xHWS als werkblad
Dim xIWS als werkblad
Dim xJWS als werkblad
Dim xKWS als werkblad
Dim xLWS als werkblad
Dim xMWS als werkblad
Dim xNWS als werkblad
Dim xPWS als werkblad
Dim xQWS als werkblad
Dim xRWS als werkblad
Dim xSWS als werkblad
Dim xTWS als werkblad
Dim xUWS als werkblad
Dim xVWS als werkblad
Dim xWWS als werkblad
Dim xXWS als werkblad
Dim xYWS als werkblad
Dim xZWS als werkblad
Gedimd 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 zo lang
Dim xDC zo lang
Dim K zo lang
Afm xC1 Zo Lang
Dim xFNum zo lang
Set xAAWS = Werkbladen("Blad1") 'Ô?Ê ÇÕá?
Set xAWS = Worksheets("Sheet2") 'åÒ??å ÈÓÊå ÈäÏ?
Set xBWS = Werkbladen("Blad3") 'åÒ?äå ÊÈá?ÛÇÊ
Set xCWS = Worksheets("Sheet4") 'åÒ?äå ÇÏÇÔ
Set xWS = Worksheets("Sheet5") 'åÒ?äå ÛÑÝå ÞÕÇÈ?
Set xEWS = Werkbladen("Sheet6") 'åÒ?äå ÍÞæÞ
Set xFWS = Worksheets("Sheet7") 'åÒ?äå ÏÑãÇä
Set xGWS = Worksheets("Sheet8")
Set xHWS = Werkbladen("Sheet9") 'åÒ?äå Ç?ÇÈ æÐåÇÈ
Set xIWS = Worksheets("Sheet10") 'ÂÈÜÜÜÜÜÜÜÏÇÑÎÜÜÜÜÜÜÇäå
Set xJWS = Worksheets("Sheet11") 'åÒíäå ÑÓäá æÙ?Ýå
Set xKWS = Werkbladen("Blad12") 'ÊäÙíÜÜÜÜÜÝ æ ÈÜÜÇÛÈÜÜÜÇäÜÜÜÜÜí
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 = Werkbladen("Sheet24") 'ÓÇíÑ åÒíäå åÇ
Set xYWS = Worksheets("Sheet25") 'åÒíäå ÍÞ ÕäÏÞÏÇÑ?
Set xZWS = Werkbladen("Blad26") 'åÒíäå áÈÇÓ
xAAR = xAAWS.UsedRange.Rijen.Count
xAR = xAWS.UsedRange.Rijen.Count
xBR = xBWS.UsedRange.Rijen.Count
xCR = xCWS.UsedRange.Rijen.Count
xDR = xWS.UsedRange.Rijen.Count
xER = xEWS.UsedRange.Rijen.Count
xFR = xFWS.UsedRange.Rijen.Count
xGR = xGWS.UsedRange.Rijen.Count
xHR = xHWS.UsedRange.Rijen.Count
xIR = xIWS.UsedRange.Rijen.Count
xJR = xJWS.UsedRange.Rijen.Count
xKR = xKWS.UsedRange.Rijen.Count
xLR = xLWS.UsedRange.Rijen.Count
xMR = xMWS.UsedRange.Rijen.Count
xNR = xNWS.UsedRange.Rijen.Count
xPR = xPWS.UsedRange.Rijen.Count
xQR = xQWS.UsedRange.Rijen.Count
xRR = xRWS.UsedRange.Rijen.Count
xSR = xSWS.UsedRange.Rijen.Count
xTR = xTWS.UsedRange.Rijen.Count
xUR = xUWS.UsedRange.Rijen.Count
xVR = xVWS.UsedRange.Rijen.Aantal
xWR = xWWS.UsedRange.Rijen.Count
xXR = xXWS.UsedRange.Rijen.Count
xYR = xYWS.UsedRange.Rijen.Count
xZR = xZWS.UsedRange.Rijen.Count
xDC = xAAWS.UsedRange.Columns.Count
Als xAR = 1 Dan
Als Application.WorksheetFunction.CountA(xAWS.UsedRange) = 0 Dan xAR = 0
End If
Als xBR = 1 Dan
Als Application.WorksheetFunction.CountA(xBWS.UsedRange) = 0 Dan xBR = 0
End If
Als xCR = 1 Dan
Als Application.WorksheetFunction.CountA(xCWS.UsedRange) = 0 Dan xCR = 0
End If
Als xDR = 1 Dan
Als Application.WorksheetFunction.CountA(xWS.UsedRange) = 0 Dan xDR = 0
End If
Als xER = 1 Dan
Als Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Dan xER = 0
End If
Als xFR = 1 Dan
Als Application.WorksheetFunction.CountA(xFWS.UsedRange) = 0 Dan xFR = 0
End If
Als xGR = 1 Dan
Als Application.WorksheetFunction.CountA(xGWS.UsedRange) = 0 Dan xGR = 0
End If
Als xHR = 1 Dan
Als Application.WorksheetFunction.CountA(xHWS.UsedRange) = 0 Dan xHR = 0
End If
Als xIR = 1 Dan
Als Application.WorksheetFunction.CountA(xIWS.UsedRange) = 0 Dan xIR = 0
End If
Als xJR = 1 Dan
Als Application.WorksheetFunction.CountA(xJWS.UsedRange) = 0 Dan xJR = 0
End If
Als xKR = 1 Dan
Als Application.WorksheetFunction.CountA(xKWS.UsedRange) = 0 Dan xKR = 0
End If
Als xLR = 1 Dan
Als Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Dan xLR = 0
End If
Als xMR = 1 Dan
Als Application.WorksheetFunction.CountA(xMWS.UsedRange) = 0 Dan xMR = 0
End If
Als xNR = 1 Dan
Als Application.WorksheetFunction.CountA(xNWS.UsedRange) = 0 Dan xNR = 0
End If
Als xPR = 1 Dan
Als Application.WorksheetFunction.CountA(xPWS.UsedRange) = 0 Dan xPR = 0
End If
Als xQR = 1 Dan
Als Application.WorksheetFunction.CountA(xQWS.UsedRange) = 0 Dan xQR = 0
End If
Als xRR = 1 Dan
Als Application.WorksheetFunction.CountA(xRWS.UsedRange) = 0 Dan xRR = 0
End If
Als xSR = 1 Dan
Als Application.WorksheetFunction.CountA(xSWS.UsedRange) = 0 Dan xSR = 0
End If
Als xTR = 1 Dan
Als Application.WorksheetFunction.CountA(xTWS.UsedRange) = 0 Dan xTR = 0
End If
Als xUR = 1 Dan
Als Application.WorksheetFunction.CountA(xUWS.UsedRange) = 0 Dan xUR = 0
End If
Als xVR = 1 Dan
Als Application.WorksheetFunction.CountA(xVWS.UsedRange) = 0 Dan xVR = 0
End If
Als xWR = 1 Dan
Als Application.WorksheetFunction.CountA(xWWS.UsedRange) = 0 Dan xWR = 0
End If
Als xXR = 1 Dan
Als Application.WorksheetFunction.CountA(xXWS.UsedRange) = 0 Dan xXR = 0
End If
Als xYR = 1 Dan
Als Application.WorksheetFunction.CountA(xYWS.UsedRange) = 0 Dan xYR = 0
End If
Als xZR = 1 Dan
Als Application.WorksheetFunction.CountA(xZWS.UsedRange) = 0 Dan xZR = 0
End If
Set xRg = xAAWS.Range("C1:C" & xAAR)
On Error Resume Next
Application.ScreenUpdating = False
Voor K = 1 tot xRg.Count
Als CStr(xRg(K).Value) = "verpakking" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xAWS.Range("A" & xAR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xAR = xAR + 1
ElseIf CStr(xRg(K).Value) = " Adverteren" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xBWS.Range("A" & xBR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xBR = xBR + 1
ElseIf CStr(xRg(K).Value) = "beloning" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xCWS.Range("A" & xCR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xCR = xCR + 1
ElseIf CStr(xRg(K).Value) = " Slagerij" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xWS.Range("A" & xDR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xDR = xDR + 1
ElseIf CStr(xRg(K).Value) = "Rechten" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xEWS.Range("A" & xER + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xER = xER + 1
ElseIf CStr(xRg(K).Value) = "behandeling" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xFWS.Range("A" & xFR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xFR = xFR + 1
ElseIf CStr(xRg(K).Value) = "Reizen en missie" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xGWS.Range("A" & xGR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xGR = xGR + 1
ElseIf CStr(xRg(K).Value) = "Transport" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xHWS.Range("A" & xHR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xHR = xHR + 1
ElseIf CStr(xRg(K).Value) = " Juice House" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xIWS.Range("A" & xIR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xIR = xIR + 1
ElseIf CStr(xRg(K).Value) = " Plichtspersoneel" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xJWS.Range("A" & xJR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xJR = xJR + 1
ElseIf CStr(xRg(K).Value) = "Schoonmaken en tuinieren" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xKWS.Range("A" & xKR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xKR = xKR + 1
ElseIf CStr(xRg(K).Value) = " Feest en ontvangst" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xLR = xLR + 1
ElseIf CStr(xRg(K).Value) = " *****" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xMWS.Range("A" & xMR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xMR = xMR + 1
ElseIf CStr(xRg(K).Value) = " Briefpapier" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xNWS.Range("A" & xNR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xNR = xNR + 1
ElseIf CStr(xRg(K).Value) = " Bankkosten" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xPWS.Range("A" & xPR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xPR = xPR + 1
ElseIf CStr(xRg(K).Value) = " Reparatie en onderhoud van meubels" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xQWS.Range("A" & xQR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xQR = xQR + 1
ElseIf CStr(xRg(K).Value) = " Gebouwonderhoud" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xRWS.Range("A" & xRR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xRR = xRR + 1
ElseIf CStr(xRg(K).Value) = " Onderhoud faciliteit" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xSWS.Range("A" & xSR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xSR = xSR + 1
ElseIf CStr(xRg(K).Value) = " Voertuigonderhoud" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xTWS.Range("A" & xTR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xTR = xTR + 1
ElseIf CStr(xRg(K).Value) = " Computerapparatuur " Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xUWS.Range("A" & xUR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xUR = xUR + 1
ElseIf CStr(xRg(K).Value) = " Voertuigbrandstof" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xVWS.Range("A" & xVR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xVR = xVR + 1
ElseIf CStr(xRg(K).Value) = " Transporteren, lossen en laden" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xWWS.Range("A" & xWR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xWR = xWR + 1
ElseIf CStr(xRg(K).Value) = " overige kosten" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xXWS.Range("A" & xXR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xXR = xXR + 1
ElseIf CStr(xRg(K).Value) = " kassa " Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xYWS.Range("A" & xYR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xYR = xYR + 1
ElseIf CStr(xRg(K).Value) = "jurk" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xZVWS.Range("A" & xZR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xZR = xZR + 1
End If
Volgende K
Application.ScreenUpdating = True
End Sub
controleer deze code plz
Submacro()
Dim xRg als bereik
Dim xCell als bereik
Dim xRRg1 als bereik
Dim xRRg2 als bereik
Dim xAAWS als werkblad
Dim xAWS als werkblad
Dim xBWS als werkblad
Dim xCWS als werkblad
Dim xDWS als werkblad
Dim xEWS als werkblad
Dim xFWS als werkblad
Dim xGWS als werkblad
Dim xHWS als werkblad
Dim xIWS als werkblad
Dim xJWS als werkblad
Dim xKWS als werkblad
Dim xLWS als werkblad
Dim xMWS als werkblad
Dim xNWS als werkblad
Dim xPWS als werkblad
Dim xQWS als werkblad
Dim xRWS als werkblad
Dim xSWS als werkblad
Dim xTWS als werkblad
Dim xUWS als werkblad
Dim xVWS als werkblad
Dim xWWS als werkblad
Dim xXWS als werkblad
Dim xYWS als werkblad
Dim xZWS als werkblad
Gedimd 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 zo lang
Dim xDC zo lang
Dim K zo lang
Afm xC1 Zo Lang
Dim xFNum zo lang
Set xAAWS = Werkbladen("Blad1") 'Ô?Ê ÇÕá?
Set xAWS = Worksheets("Sheet2") 'åÒ??å ÈÓÊå ÈäÏ?
Set xBWS = Werkbladen("Blad3") 'åÒ?äå ÊÈá?ÛÇÊ
Set xCWS = Worksheets("Sheet4") 'åÒ?äå ÇÏÇÔ
Set xWS = Worksheets("Sheet5") 'åÒ?äå ÛÑÝå ÞÕÇÈ?
Set xEWS = Werkbladen("Sheet6") 'åÒ?äå ÍÞæÞ
Set xFWS = Worksheets("Sheet7") 'åÒ?äå ÏÑãÇä
Set xGWS = Worksheets("Sheet8")
Set xHWS = Werkbladen("Sheet9") 'åÒ?äå Ç?ÇÈ æÐåÇÈ
Set xIWS = Worksheets("Sheet10") 'ÂÈÜÜÜÜÜÜÜÏÇÑÎÜÜÜÜÜÜÇäå
Set xJWS = Worksheets("Sheet11") 'åÒíäå ÑÓäá æÙ?Ýå
Set xKWS = Werkbladen("Blad12") 'ÊäÙíÜÜÜÜÜÝ æ ÈÜÜÇÛÈÜÜÜÇäÜÜÜÜÜí
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 = Werkbladen("Sheet24") 'ÓÇíÑ åÒíäå åÇ
Set xYWS = Worksheets("Sheet25") 'åÒíäå ÍÞ ÕäÏÞÏÇÑ?
Set xZWS = Werkbladen("Blad26") 'åÒíäå áÈÇÓ
xAAR = xAAWS.UsedRange.Rijen.Count
xAR = xAWS.UsedRange.Rijen.Count
xBR = xBWS.UsedRange.Rijen.Count
xCR = xCWS.UsedRange.Rijen.Count
xDR = xWS.UsedRange.Rijen.Count
xER = xEWS.UsedRange.Rijen.Count
xFR = xFWS.UsedRange.Rijen.Count
xGR = xGWS.UsedRange.Rijen.Count
xHR = xHWS.UsedRange.Rijen.Count
xIR = xIWS.UsedRange.Rijen.Count
xJR = xJWS.UsedRange.Rijen.Count
xKR = xKWS.UsedRange.Rijen.Count
xLR = xLWS.UsedRange.Rijen.Count
xMR = xMWS.UsedRange.Rijen.Count
xNR = xNWS.UsedRange.Rijen.Count
xPR = xPWS.UsedRange.Rijen.Count
xQR = xQWS.UsedRange.Rijen.Count
xRR = xRWS.UsedRange.Rijen.Count
xSR = xSWS.UsedRange.Rijen.Count
xTR = xTWS.UsedRange.Rijen.Count
xUR = xUWS.UsedRange.Rijen.Count
xVR = xVWS.UsedRange.Rijen.Aantal
xWR = xWWS.UsedRange.Rijen.Count
xXR = xXWS.UsedRange.Rijen.Count
xYR = xYWS.UsedRange.Rijen.Count
xZR = xZWS.UsedRange.Rijen.Count
xDC = xAAWS.UsedRange.Columns.Count
Als xAR = 1 Dan
Als Application.WorksheetFunction.CountA(xAWS.UsedRange) = 0 Dan xAR = 0
End If
Als xBR = 1 Dan
Als Application.WorksheetFunction.CountA(xBWS.UsedRange) = 0 Dan xBR = 0
End If
Als xCR = 1 Dan
Als Application.WorksheetFunction.CountA(xCWS.UsedRange) = 0 Dan xCR = 0
End If
Als xDR = 1 Dan
Als Application.WorksheetFunction.CountA(xWS.UsedRange) = 0 Dan xDR = 0
End If
Als xER = 1 Dan
Als Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Dan xER = 0
End If
Als xFR = 1 Dan
Als Application.WorksheetFunction.CountA(xFWS.UsedRange) = 0 Dan xFR = 0
End If
Als xGR = 1 Dan
Als Application.WorksheetFunction.CountA(xGWS.UsedRange) = 0 Dan xGR = 0
End If
Als xHR = 1 Dan
Als Application.WorksheetFunction.CountA(xHWS.UsedRange) = 0 Dan xHR = 0
End If
Als xIR = 1 Dan
Als Application.WorksheetFunction.CountA(xIWS.UsedRange) = 0 Dan xIR = 0
End If
Als xJR = 1 Dan
Als Application.WorksheetFunction.CountA(xJWS.UsedRange) = 0 Dan xJR = 0
End If
Als xKR = 1 Dan
Als Application.WorksheetFunction.CountA(xKWS.UsedRange) = 0 Dan xKR = 0
End If
Als xLR = 1 Dan
Als Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Dan xLR = 0
End If
Als xMR = 1 Dan
Als Application.WorksheetFunction.CountA(xMWS.UsedRange) = 0 Dan xMR = 0
End If
Als xNR = 1 Dan
Als Application.WorksheetFunction.CountA(xNWS.UsedRange) = 0 Dan xNR = 0
End If
Als xPR = 1 Dan
Als Application.WorksheetFunction.CountA(xPWS.UsedRange) = 0 Dan xPR = 0
End If
Als xQR = 1 Dan
Als Application.WorksheetFunction.CountA(xQWS.UsedRange) = 0 Dan xQR = 0
End If
Als xRR = 1 Dan
Als Application.WorksheetFunction.CountA(xRWS.UsedRange) = 0 Dan xRR = 0
End If
Als xSR = 1 Dan
Als Application.WorksheetFunction.CountA(xSWS.UsedRange) = 0 Dan xSR = 0
End If
Als xTR = 1 Dan
Als Application.WorksheetFunction.CountA(xTWS.UsedRange) = 0 Dan xTR = 0
End If
Als xUR = 1 Dan
Als Application.WorksheetFunction.CountA(xUWS.UsedRange) = 0 Dan xUR = 0
End If
Als xVR = 1 Dan
Als Application.WorksheetFunction.CountA(xVWS.UsedRange) = 0 Dan xVR = 0
End If
Als xWR = 1 Dan
Als Application.WorksheetFunction.CountA(xWWS.UsedRange) = 0 Dan xWR = 0
End If
Als xXR = 1 Dan
Als Application.WorksheetFunction.CountA(xXWS.UsedRange) = 0 Dan xXR = 0
End If
Als xYR = 1 Dan
Als Application.WorksheetFunction.CountA(xYWS.UsedRange) = 0 Dan xYR = 0
End If
Als xZR = 1 Dan
Als Application.WorksheetFunction.CountA(xZWS.UsedRange) = 0 Dan xZR = 0
End If
Set xRg = xAAWS.Range("C1:C" & xAAR)
On Error Resume Next
Application.ScreenUpdating = False
Voor K = 1 tot xRg.Count
Als CStr(xRg(K).Value) = "verpakking" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xAWS.Range("A" & xAR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xAR = xAR + 1
ElseIf CStr(xRg(K).Value) = " Adverteren" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xBWS.Range("A" & xBR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xBR = xBR + 1
ElseIf CStr(xRg(K).Value) = "beloning" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xCWS.Range("A" & xCR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xCR = xCR + 1
ElseIf CStr(xRg(K).Value) = " Slagerij" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xWS.Range("A" & xDR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xDR = xDR + 1
ElseIf CStr(xRg(K).Value) = "Rechten" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xEWS.Range("A" & xER + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xER = xER + 1
ElseIf CStr(xRg(K).Value) = "behandeling" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xFWS.Range("A" & xFR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xFR = xFR + 1
ElseIf CStr(xRg(K).Value) = "Reizen en missie" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xGWS.Range("A" & xGR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xGR = xGR + 1
ElseIf CStr(xRg(K).Value) = "Transport" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xHWS.Range("A" & xHR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xHR = xHR + 1
ElseIf CStr(xRg(K).Value) = " Juice House" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xIWS.Range("A" & xIR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xIR = xIR + 1
ElseIf CStr(xRg(K).Value) = " Plichtspersoneel" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xJWS.Range("A" & xJR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xJR = xJR + 1
ElseIf CStr(xRg(K).Value) = "Schoonmaken en tuinieren" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xKWS.Range("A" & xKR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xKR = xKR + 1
ElseIf CStr(xRg(K).Value) = " Feest en ontvangst" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xLR = xLR + 1
ElseIf CStr(xRg(K).Value) = " *****" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xMWS.Range("A" & xMR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xMR = xMR + 1
ElseIf CStr(xRg(K).Value) = " Briefpapier" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xNWS.Range("A" & xNR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xNR = xNR + 1
ElseIf CStr(xRg(K).Value) = " Bankkosten" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xPWS.Range("A" & xPR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xPR = xPR + 1
ElseIf CStr(xRg(K).Value) = " Reparatie en onderhoud van meubels" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xQWS.Range("A" & xQR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xQR = xQR + 1
ElseIf CStr(xRg(K).Value) = " Gebouwonderhoud" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xRWS.Range("A" & xRR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xRR = xRR + 1
ElseIf CStr(xRg(K).Value) = " Onderhoud faciliteit" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xSWS.Range("A" & xSR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xSR = xSR + 1
ElseIf CStr(xRg(K).Value) = " Voertuigonderhoud" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xTWS.Range("A" & xTR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xTR = xTR + 1
ElseIf CStr(xRg(K).Value) = " Computerapparatuur " Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xUWS.Range("A" & xUR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xUR = xUR + 1
ElseIf CStr(xRg(K).Value) = " Voertuigbrandstof" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xVWS.Range("A" & xVR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xVR = xVR + 1
ElseIf CStr(xRg(K).Value) = " Transporteren, lossen en laden" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xWWS.Range("A" & xWR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xWR = xWR + 1
ElseIf CStr(xRg(K).Value) = " overige kosten" Then
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xXWS.Range("A" & xXR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xXR = xXR + 1
ElseIf CStr(xRg(K).Value) = " kassa " Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xYWS.Range("A" & xYR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xYR = xYR + 1
ElseIf CStr(xRg(K).Value) = "jurk" Dan
Stel xRRg1 = xRg(K).Volledige rij in
Stel xRRg2 = xZVWS.Range("A" & xZR + 1).EntireRow in
Voor xFNum = 1 tot xDC
xRRg2.Waarde = xRRg1.Waarde
Volgende xFNum
xRg(K).Volledige rij.Verwijderen
xZR = xZR + 1
End If
Volgende K
Application.ScreenUpdating = True
End Sub