γειά σου
ελέγξτε αυτόν τον κωδικό plz
Υπομακροεντολή()
Dim xRg ως εύρος
Dim xCell ως εύρος
Dim xRRg1 ως εύρος
Dim xRRg2 ως εύρος
Dim xAAWS ως φύλλο εργασίας
Dim xAWS ως φύλλο εργασίας
Dim xBWS ως φύλλο εργασίας
Dim xCWS ως φύλλο εργασίας
Dim xDWS ως φύλλο εργασίας
Dim xEWS ως φύλλο εργασίας
Dim xFWS ως φύλλο εργασίας
Dim xGWS ως φύλλο εργασίας
Dim xHWS ως φύλλο εργασίας
Dim xIWS ως φύλλο εργασίας
Dim xJWS ως φύλλο εργασίας
Dim xKWS ως φύλλο εργασίας
Dim xLWS ως φύλλο εργασίας
Dim xMWS ως φύλλο εργασίας
Dim xNWS ως φύλλο εργασίας
Dim xPWS ως φύλλο εργασίας
Dim xQWS ως φύλλο εργασίας
Dim xRWS ως φύλλο εργασίας
Dim xSWS ως φύλλο εργασίας
Dim xTWS ως φύλλο εργασίας
Dim xUWS ως φύλλο εργασίας
Dim xVWS ως φύλλο εργασίας
Dim xWWS ως φύλλο εργασίας
Dim xXWS ως φύλλο εργασίας
Dim xYWS ως φύλλο εργασίας
Dim xZWS ως φύλλο εργασίας
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
Ορισμός xAAWS = Φύλλα εργασίας("Φύλλο1") 'Ô?Ê ÇÕá?
Ορισμός xAWS = Φύλλα εργασίας("Φύλλο2") 'åÒ??å ÈÓÊå ÈäÏ?
Ορισμός xBWS = Φύλλα εργασίας ("Φύλλο 3") 'åÒ?äå ÊÈá?ÛÇÊ
Ορισμός xCWS = Φύλλα εργασίας ("Φύλλο 4") 'åÒ?äå ÇÏÇÔ
Ορίστε xWS = Φύλλα εργασίας("Φύλλο5") 'åÒ?äå ÛÑÝå ÞÕÇÈ?
Ορισμός xEWS = Φύλλα εργασίας ("Φύλλο6") 'åÒ?äå ÍÞæÞ
Ορισμός xFWS = Φύλλα εργασίας ("Φύλλο 7") 'åÒ?äå ÏÑãÇä
Ορισμός xGWS = Φύλλα εργασίας("Φύλλο8") 'åÒ?äå ÓÝÑæÝæÞ ÇáÚÇÏå ãÇãæÑ?Ê ÏÇÎá ˜ÔæÑ
Σετ xHWS = Φύλλα εργασίας ("Φύλλο 9") 'åÒ?äå Ç?ÇÈ æÐåÇÈ
Σετ xIWS = Φύλλα εργασίας ("Φύλλο 10") 'ÂÈÜÜÜÜÜÜÏÇÑÎÜÜÜÜÜÜÇäå
Ορισμός xJWS = Φύλλα εργασίας ("Φύλλο 11") 'åÒíäå ÑÓäá æÙ?Ýå
Σετ xKWS = Φύλλα εργασίας ("Φύλλο12") 'ÊäÙíÜÜÜÜÜÝ æ ÈÜÜÇÛÈÜÜÜÇäÜÜÜÜÜí
Ορισμός xLWS = Φύλλα εργασίας("Φύλλο13") 'åÒíäå ÌÔä æ ÐíÑÇí?
Ορισμός xMWS = Φύλλα εργασίας ("Φύλλο 14") 'åÒíäå ÓÊ ÊáÝä
Ορισμός xNWS = Φύλλα εργασίας ("Φύλλο 15") 'åÒíäå äæÔÊ ÇÝÒÇÑ
Σετ xPWS = Φύλλα εργασίας ("Φύλλο 16") 'åÒíäå ÈÇä˜í
Ορισμός xQWS = Φύλλα εργασίας ("Φύλλο 17") 'ÊÚãíÑ æ ä åÏÇÑí ÇËÜÜÜÜÜÜÇËå
Ορισμός xRWS = Φύλλα εργασίας("Φύλλο18") 'åÒ?äå ÊÚã?Ñ æä åÏÇÑí ÓÇÎÊãÇä
Ορισμός xSWS = Φύλλα εργασίας("Φύλλο19") 'åÒ?äå ÊÚã?Ñ æä åÏÇÑí ÊÇÓ?ÓÇÊ
Ορισμός xTWS = Φύλλα εργασίας ("Φύλλο 20") 'åÒ?äå ÊÚã?Ñ æÓÇÆØ äÞáíå
Σετ xUWS = Φύλλα εργασίας("Φύλλο21") 'åÒ?äå ÊÌå?ÒÇÊ ÑÇ?Çäå
Σετ xVWS = Φύλλα εργασίας ("Φύλλο 22") 'åÒ?äå ÓæÎÊ æÓÇÆØ äÞá?å
Ορισμός xWWS = Φύλλα εργασίας("Φύλλο23") 'åÒ?äå Íãá æäÞá æÊÎá?å æÈÇÑ ?Ñ?
Σετ xXWS = Φύλλα εργασίας ("Φύλλο 24") 'ÓÇíÑ åÒíäå åÇ
Ορισμός xYWS = Φύλλα εργασίας("Φύλλο25") 'åÒíäå ÍÞ ÕäÏÞÏÇÑ?
Ορισμός xZWS = Φύλλα εργασίας ("Φύλλο 26") 'åÒíäå áÈÇÓ
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
Αν xAR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xAWS.UsedRange) = 0 Τότε xAR = 0
End If
Αν xBR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xBWS.UsedRange) = 0 Τότε xBR = 0
End If
Αν xCR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xCWS.UsedRange) = 0 Τότε xCR = 0
End If
Αν xDR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xWS.UsedRange) = 0 Τότε xDR = 0
End If
Αν xER = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Τότε xER = 0
End If
Αν xFR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xFWS.UsedRange) = 0 Τότε xFR = 0
End If
Αν xGR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xGWS.UsedRange) = 0 Τότε xGR = 0
End If
Αν xHR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xHWS.UsedRange) = 0 Τότε xHR = 0
End If
Αν xIR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xIWS.UsedRange) = 0 Τότε xIR = 0
End If
Αν xJR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xJWS.UsedRange) = 0 Τότε xJR = 0
End If
Αν xKR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xKWS.UsedRange) = 0 Τότε xKR = 0
End If
Αν xLR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Τότε xLR = 0
End If
Αν xMR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xMWS.UsedRange) = 0 Τότε xMR = 0
End If
Αν xNR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xNWS.UsedRange) = 0 Τότε xNR = 0
End If
Αν xPR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xPWS.UsedRange) = 0 Τότε xPR = 0
End If
Αν xQR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xQWS.UsedRange) = 0 Τότε xQR = 0
End If
Αν xRR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xRWS.UsedRange) = 0 Τότε xRR = 0
End If
Αν xSR = 1 Τότε
Αν Application.WorksheetFunction.CountA(xSWS.UsedRange) = 0 Τότε xSR = 0
End If
Αν xTR = 1 Τότε
Αν Application.WorksheetFunction.CountA(xTWS.UsedRange) = 0 Τότε xTR = 0
End If
Αν xUR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xUWS.UsedRange) = 0 Τότε xUR = 0
End If
Αν xVR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xVWS.UsedRange) = 0 Τότε xVR = 0
End If
Αν xWR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xWWS.UsedRange) = 0 Τότε xWR = 0
End If
Αν xXR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xXWS.UsedRange) = 0 Τότε xXR = 0
End If
Αν xYR = 1 Τότε
Αν Application.WorksheetFunction.CountA(xYWS.UsedRange) = 0 Τότε xYR = 0
End If
Αν xZR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xZWS.UsedRange) = 0 Τότε xZR = 0
End If
Ορισμός xRg = xAAWS.Range("C1:C" & xAAR)
On Error Συνέχιση Επόμενη
Application.ScreenUpdating = False
Για K = 1 To xRg.Count
Αν CStr(xRg(K).Value) = "packing" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xAWS.Range("A" & xAR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xAR = xAR + 1
ElseIf CStr(xRg(K).Value) = "Διαφήμιση" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xBWS.Range("A" & xBR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xBR = xBR + 1
ElseIf CStr(xRg(K).Value) = "ανταμοιβή" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xCWS.Range("A" & xCR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xCR = xCR + 1
ElseIf CStr(xRg(K).Value) = "Κρεοπωλείο" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xWS.Range("A" & xDR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xDR = xDR + 1
ElseIf CStr(xRg(K).Value) = "Δικαιώματα" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xEWS.Range("A" & xER + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xER = xER + 1
ElseIf CStr(xRg(K).Value) = "θεραπεία" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xFWS.Range("A" & xFR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xFR = xFR + 1
ElseIf CStr(xRg(K).Value) = "Ταξίδι και αποστολή" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xGWS.Range("A" & xGR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xGR = xGR + 1
ElseIf CStr(xRg(K).Value) = "Μεταφορά" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xHWS.Range("A" & xHR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xHR = xHR + 1
ElseIf CStr(xRg(K).Value) = "Jice House" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xIWS.Range("A" & xIR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xIR = xIR + 1
ElseIf CStr(xRg(K).Value) = " Προσωπικό υπηρεσίας" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xJWS.Range("A" & xJR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xJR = xJR + 1
ElseIf CStr(xRg(K).Value) = "Καθαρισμός και κηπουρική" Στη συνέχεια
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xKWS.Range("A" & xKR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xKR = xKR + 1
ElseIf CStr(xRg(K).Value) = " Γιορτή και δεξίωση" Στη συνέχεια
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xLR = xLR + 1
ElseIf CStr(xRg(K).Value) = " *****" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xMWS.Range("A" & xMR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xMR = xMR + 1
ElseIf CStr(xRg(K).Value) = " Χαρτικά" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xNWS.Range("A" & xNR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xNR = xNR + 1
ElseIf CStr(xRg(K).Value) = "Τραπεζικές χρεώσεις" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xPWS.Range("A" & xPR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xPR = xPR + 1
ElseIf CStr(xRg(K).Value) = " Επισκευή και συντήρηση επίπλων" Στη συνέχεια
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xQWS.Range("A" & xQR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xQR = xQR + 1
ElseIf CStr(xRg(K).Value) = "Συντήρηση κτιρίου" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xRWS.Range("A" & xRR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xRR = xRR + 1
ElseIf CStr(xRg(K).Value) = "Συντήρηση εγκατάστασης" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xSWS.Range("A" & xSR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xSR = xSR + 1
ElseIf CStr(xRg(K).Value) = "Συντήρηση οχήματος" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xTWS.Range("A" & xTR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xTR = xTR + 1
ElseIf CStr(xRg(K).Value) = " Εξοπλισμός υπολογιστή " Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xUWS.Range("A" & xUR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xUR = xUR + 1
ElseIf CStr(xRg(K).Value) = "Καύσιμο οχήματος" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xVWS.Range("A" & xVR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xVR = xVR + 1
ElseIf CStr(xRg(K).Value) = "Μεταφορά, εκφόρτωση και φόρτωση" Στη συνέχεια
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xWWS.Range("A" & xWR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xWR = xWR + 1
ElseIf CStr(xRg(K).Value) = "άλλο κόστος" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xXWS.Range("A" & xXR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xXR = xXR + 1
ElseIf CStr(xRg(K).Value) = " ταμείο " Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xYWS.Range("A" & xYR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xYR = xYR + 1
ElseIf CStr(xRg(K).Value) = "φόρεμα" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xZVWS.Range("A" & xZR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xZR = xZR + 1
End If
Επόμενος Κ
Application.ScreenUpdating = True
Sub End
ελέγξτε αυτόν τον κωδικό plz
Υπομακροεντολή()
Dim xRg ως εύρος
Dim xCell ως εύρος
Dim xRRg1 ως εύρος
Dim xRRg2 ως εύρος
Dim xAAWS ως φύλλο εργασίας
Dim xAWS ως φύλλο εργασίας
Dim xBWS ως φύλλο εργασίας
Dim xCWS ως φύλλο εργασίας
Dim xDWS ως φύλλο εργασίας
Dim xEWS ως φύλλο εργασίας
Dim xFWS ως φύλλο εργασίας
Dim xGWS ως φύλλο εργασίας
Dim xHWS ως φύλλο εργασίας
Dim xIWS ως φύλλο εργασίας
Dim xJWS ως φύλλο εργασίας
Dim xKWS ως φύλλο εργασίας
Dim xLWS ως φύλλο εργασίας
Dim xMWS ως φύλλο εργασίας
Dim xNWS ως φύλλο εργασίας
Dim xPWS ως φύλλο εργασίας
Dim xQWS ως φύλλο εργασίας
Dim xRWS ως φύλλο εργασίας
Dim xSWS ως φύλλο εργασίας
Dim xTWS ως φύλλο εργασίας
Dim xUWS ως φύλλο εργασίας
Dim xVWS ως φύλλο εργασίας
Dim xWWS ως φύλλο εργασίας
Dim xXWS ως φύλλο εργασίας
Dim xYWS ως φύλλο εργασίας
Dim xZWS ως φύλλο εργασίας
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
Ορισμός xAAWS = Φύλλα εργασίας("Φύλλο1") 'Ô?Ê ÇÕá?
Ορισμός xAWS = Φύλλα εργασίας("Φύλλο2") 'åÒ??å ÈÓÊå ÈäÏ?
Ορισμός xBWS = Φύλλα εργασίας ("Φύλλο 3") 'åÒ?äå ÊÈá?ÛÇÊ
Ορισμός xCWS = Φύλλα εργασίας ("Φύλλο 4") 'åÒ?äå ÇÏÇÔ
Ορίστε xWS = Φύλλα εργασίας("Φύλλο5") 'åÒ?äå ÛÑÝå ÞÕÇÈ?
Ορισμός xEWS = Φύλλα εργασίας ("Φύλλο6") 'åÒ?äå ÍÞæÞ
Ορισμός xFWS = Φύλλα εργασίας ("Φύλλο 7") 'åÒ?äå ÏÑãÇä
Ορισμός xGWS = Φύλλα εργασίας("Φύλλο8") 'åÒ?äå ÓÝÑæÝæÞ ÇáÚÇÏå ãÇãæÑ?Ê ÏÇÎá ˜ÔæÑ
Σετ xHWS = Φύλλα εργασίας ("Φύλλο 9") 'åÒ?äå Ç?ÇÈ æÐåÇÈ
Σετ xIWS = Φύλλα εργασίας ("Φύλλο 10") 'ÂÈÜÜÜÜÜÜÏÇÑÎÜÜÜÜÜÜÇäå
Ορισμός xJWS = Φύλλα εργασίας ("Φύλλο 11") 'åÒíäå ÑÓäá æÙ?Ýå
Σετ xKWS = Φύλλα εργασίας ("Φύλλο12") 'ÊäÙíÜÜÜÜÜÝ æ ÈÜÜÇÛÈÜÜÜÇäÜÜÜÜÜí
Ορισμός xLWS = Φύλλα εργασίας("Φύλλο13") 'åÒíäå ÌÔä æ ÐíÑÇí?
Ορισμός xMWS = Φύλλα εργασίας ("Φύλλο 14") 'åÒíäå ÓÊ ÊáÝä
Ορισμός xNWS = Φύλλα εργασίας ("Φύλλο 15") 'åÒíäå äæÔÊ ÇÝÒÇÑ
Σετ xPWS = Φύλλα εργασίας ("Φύλλο 16") 'åÒíäå ÈÇä˜í
Ορισμός xQWS = Φύλλα εργασίας ("Φύλλο 17") 'ÊÚãíÑ æ ä åÏÇÑí ÇËÜÜÜÜÜÜÇËå
Ορισμός xRWS = Φύλλα εργασίας("Φύλλο18") 'åÒ?äå ÊÚã?Ñ æä åÏÇÑí ÓÇÎÊãÇä
Ορισμός xSWS = Φύλλα εργασίας("Φύλλο19") 'åÒ?äå ÊÚã?Ñ æä åÏÇÑí ÊÇÓ?ÓÇÊ
Ορισμός xTWS = Φύλλα εργασίας ("Φύλλο 20") 'åÒ?äå ÊÚã?Ñ æÓÇÆØ äÞáíå
Σετ xUWS = Φύλλα εργασίας("Φύλλο21") 'åÒ?äå ÊÌå?ÒÇÊ ÑÇ?Çäå
Σετ xVWS = Φύλλα εργασίας ("Φύλλο 22") 'åÒ?äå ÓæÎÊ æÓÇÆØ äÞá?å
Ορισμός xWWS = Φύλλα εργασίας("Φύλλο23") 'åÒ?äå Íãá æäÞá æÊÎá?å æÈÇÑ ?Ñ?
Σετ xXWS = Φύλλα εργασίας ("Φύλλο 24") 'ÓÇíÑ åÒíäå åÇ
Ορισμός xYWS = Φύλλα εργασίας("Φύλλο25") 'åÒíäå ÍÞ ÕäÏÞÏÇÑ?
Ορισμός xZWS = Φύλλα εργασίας ("Φύλλο 26") 'åÒíäå áÈÇÓ
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
Αν xAR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xAWS.UsedRange) = 0 Τότε xAR = 0
End If
Αν xBR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xBWS.UsedRange) = 0 Τότε xBR = 0
End If
Αν xCR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xCWS.UsedRange) = 0 Τότε xCR = 0
End If
Αν xDR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xWS.UsedRange) = 0 Τότε xDR = 0
End If
Αν xER = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Τότε xER = 0
End If
Αν xFR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xFWS.UsedRange) = 0 Τότε xFR = 0
End If
Αν xGR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xGWS.UsedRange) = 0 Τότε xGR = 0
End If
Αν xHR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xHWS.UsedRange) = 0 Τότε xHR = 0
End If
Αν xIR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xIWS.UsedRange) = 0 Τότε xIR = 0
End If
Αν xJR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xJWS.UsedRange) = 0 Τότε xJR = 0
End If
Αν xKR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xKWS.UsedRange) = 0 Τότε xKR = 0
End If
Αν xLR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Τότε xLR = 0
End If
Αν xMR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xMWS.UsedRange) = 0 Τότε xMR = 0
End If
Αν xNR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xNWS.UsedRange) = 0 Τότε xNR = 0
End If
Αν xPR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xPWS.UsedRange) = 0 Τότε xPR = 0
End If
Αν xQR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xQWS.UsedRange) = 0 Τότε xQR = 0
End If
Αν xRR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xRWS.UsedRange) = 0 Τότε xRR = 0
End If
Αν xSR = 1 Τότε
Αν Application.WorksheetFunction.CountA(xSWS.UsedRange) = 0 Τότε xSR = 0
End If
Αν xTR = 1 Τότε
Αν Application.WorksheetFunction.CountA(xTWS.UsedRange) = 0 Τότε xTR = 0
End If
Αν xUR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xUWS.UsedRange) = 0 Τότε xUR = 0
End If
Αν xVR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xVWS.UsedRange) = 0 Τότε xVR = 0
End If
Αν xWR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xWWS.UsedRange) = 0 Τότε xWR = 0
End If
Αν xXR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xXWS.UsedRange) = 0 Τότε xXR = 0
End If
Αν xYR = 1 Τότε
Αν Application.WorksheetFunction.CountA(xYWS.UsedRange) = 0 Τότε xYR = 0
End If
Αν xZR = 1 Τότε
Εάν Application.WorksheetFunction.CountA(xZWS.UsedRange) = 0 Τότε xZR = 0
End If
Ορισμός xRg = xAAWS.Range("C1:C" & xAAR)
On Error Συνέχιση Επόμενη
Application.ScreenUpdating = False
Για K = 1 To xRg.Count
Αν CStr(xRg(K).Value) = "packing" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xAWS.Range("A" & xAR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xAR = xAR + 1
ElseIf CStr(xRg(K).Value) = "Διαφήμιση" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xBWS.Range("A" & xBR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xBR = xBR + 1
ElseIf CStr(xRg(K).Value) = "ανταμοιβή" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xCWS.Range("A" & xCR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xCR = xCR + 1
ElseIf CStr(xRg(K).Value) = "Κρεοπωλείο" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xWS.Range("A" & xDR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xDR = xDR + 1
ElseIf CStr(xRg(K).Value) = "Δικαιώματα" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xEWS.Range("A" & xER + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xER = xER + 1
ElseIf CStr(xRg(K).Value) = "θεραπεία" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xFWS.Range("A" & xFR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xFR = xFR + 1
ElseIf CStr(xRg(K).Value) = "Ταξίδι και αποστολή" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xGWS.Range("A" & xGR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xGR = xGR + 1
ElseIf CStr(xRg(K).Value) = "Μεταφορά" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xHWS.Range("A" & xHR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xHR = xHR + 1
ElseIf CStr(xRg(K).Value) = "Jice House" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xIWS.Range("A" & xIR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xIR = xIR + 1
ElseIf CStr(xRg(K).Value) = " Προσωπικό υπηρεσίας" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xJWS.Range("A" & xJR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xJR = xJR + 1
ElseIf CStr(xRg(K).Value) = "Καθαρισμός και κηπουρική" Στη συνέχεια
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xKWS.Range("A" & xKR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xKR = xKR + 1
ElseIf CStr(xRg(K).Value) = " Γιορτή και δεξίωση" Στη συνέχεια
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xLR = xLR + 1
ElseIf CStr(xRg(K).Value) = " *****" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xMWS.Range("A" & xMR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xMR = xMR + 1
ElseIf CStr(xRg(K).Value) = " Χαρτικά" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xNWS.Range("A" & xNR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xNR = xNR + 1
ElseIf CStr(xRg(K).Value) = "Τραπεζικές χρεώσεις" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xPWS.Range("A" & xPR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xPR = xPR + 1
ElseIf CStr(xRg(K).Value) = " Επισκευή και συντήρηση επίπλων" Στη συνέχεια
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xQWS.Range("A" & xQR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xQR = xQR + 1
ElseIf CStr(xRg(K).Value) = "Συντήρηση κτιρίου" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xRWS.Range("A" & xRR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xRR = xRR + 1
ElseIf CStr(xRg(K).Value) = "Συντήρηση εγκατάστασης" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xSWS.Range("A" & xSR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xSR = xSR + 1
ElseIf CStr(xRg(K).Value) = "Συντήρηση οχήματος" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xTWS.Range("A" & xTR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xTR = xTR + 1
ElseIf CStr(xRg(K).Value) = " Εξοπλισμός υπολογιστή " Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xUWS.Range("A" & xUR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xUR = xUR + 1
ElseIf CStr(xRg(K).Value) = "Καύσιμο οχήματος" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xVWS.Range("A" & xVR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xVR = xVR + 1
ElseIf CStr(xRg(K).Value) = "Μεταφορά, εκφόρτωση και φόρτωση" Στη συνέχεια
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xWWS.Range("A" & xWR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xWR = xWR + 1
ElseIf CStr(xRg(K).Value) = "άλλο κόστος" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xXWS.Range("A" & xXR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xXR = xXR + 1
ElseIf CStr(xRg(K).Value) = " ταμείο " Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xYWS.Range("A" & xYR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xYR = xYR + 1
ElseIf CStr(xRg(K).Value) = "φόρεμα" Τότε
Ορίστε xRRg1 = xRg(K).EntireRow
Ορισμός xRRg2 = xZVWS.Range("A" & xZR + 1).EntireRow
Για xFNum = 1 έως xDC
xRRg2.Value = xRRg1.Value
Επόμενο xFNum
xRg(K).EntireRow.Delete
xZR = xZR + 1
End If
Επόμενος Κ
Application.ScreenUpdating = True
Sub End