[Γενικά] Τακτοποίηση δεδομένων

[Immortal]

Καλησπέρα, έχω 4 περιοχές με δεδομένα. Άλλη μία όπου θέλω να τα συγκεντρώνω.
Από τις 4 περιοχές(Sections 1 έως 4) θέλω ότι δεδομένα υπάρχουν στην στήλη με τίτλο 1 να συγκεντρωθούν στην περιοχή All Sections στην στήλη με τίτλο 1, αντίστοιχα και για τις υπόλοιπες στήλες.
Μετά από αρκετό ψάξιμο βρήκα μια συνάρτηση η οποία δείχνει να κάνει αυτό που χρειάζομαι.

Στην περιοχή με κίτρινο χρώμα έχω 4 στήλες, μία για κάθε section.
Εδώ θέλω στην στήλη με τίτλο Section 1 όλα τα δεδομένα που υπάρχουν στην περιοχή Section1 ανά στήλη(από στήλη με τίτλο 1 έως στήλη με τίτλο 20), χρησιμοποίησα την ίδια συνάρτηση, όμως μου δίνει τα δεδομένα κατά σειρά.

Υπάρχει τρόπος, άλλη συνάρτηση, ή οτιδήποτε άλλο το οποίο θα μου δώσει τα δεδομένα κατά στήλη;
Κάθε βοήθεια, διόρθωση, πρόταση δεκτη!
Σας ευχαριστώ

[ChrisGT7]

Καλησπέρα Νίκο,

Στη στήλη DC (Section 1) θέλεις να έχεις το παρακάτω αποτέλεσμα:

W1
W12
QW34
QW11
QW22
QW23

και όχι αυτό που υπάρχει στο συνημμένο παράδειγμα με τον συγκεκριμένο τύπο;

Δηλαδή κάθε στήλη section του κίτρινου πίνακα, να έχει τις 20 στήλες κάθε αντίστοιχου πίνακα section τη μία κάτω από την άλλη;

[Immortal]

Ναι Χρήστο, πολύ σωστά!

[ChrisGT7]

Δοκίμασε τον παρακάτω κώδικα αν σε καλύπτει:

Option Explicit

Sub METAFORA()
    Dim SC As Byte
    Dim R1 As Long, R2 As Long
    Dim C1 As Long, C2 As Long
    
    Application.ScreenUpdating = False
    Range("DC3:DF" & Rows.Count).ClearContents
    
    For SC = 1 To 4
        R2 = 3
        For C1 = 2 + SC * 21 To 21 + SC * 21
            R1 = 3
            Do
                If Cells(R1, C1).Value = "" Then
                    R1 = 0
                Else
                    Cells(R2, Evaluate("MATCH(""Section ""&" & SC & ",2:2,0)")).Value = Cells(R1, C1).Value
                    R1 = R1 + 1
                    R2 = R2 + 1
                End If
            Loop While R1 > 0
        Next
    Next
    
    Application.ScreenUpdating = True
End Sub

Θεωρώ πως τα δεδομένα στις στήλες είναι συνεχόμενα (το ένα κάτω από το άλλο) και δεν παρεμβάλονται μεταξύ τους κενά κελιά.

[Immortal]

Χρήστο σε ευχαριστώ, θα το δοκιμάσω κ θα σε ενημερώσω για το αποτέλεσμα.

Ότι θα ήθελε κάποιος να κανονίσει ραντεβού μέσα από κώδικα vba, και κρύβει το d a t i n g, ούτε που θα το φανταζόμουν

[Immortal]

Χρήστο δουλεύει άψογα! Να είσαι καλά!

Μία ερώτηση, σχετικά με τις ονομασίες Section 1 έως 4, εάν αντικαταστήσω το Section στο φύλλο αλλά και στο κομμάτι του κώδικα παρακάτω με άλλη λέξη π.χ. Τμήμα νομίζω πως δεν θα επηρεάσει την λειτουργία

Cells(R2, Evaluate("MATCH(""Τμήμα ""&" & SC & ",2:2,0)")).Value = Cells(R1, C1).Value

Επίσης, στην περίπτωση που θέλω να ακυρώσω την λέξη Section (ή Τμήμα) τελείως και να κρατήσω μόνο το 1 to 4, η τροποποίηση του κώδικα θα είναι πολύπλοκη;

Αν θελήσω να αλλάξω το 1 έως 4 σε Α Β Γ Δ; Είναι αυτό εφικτό; Και αν ναι, στο παρακάτω κομμάτι πως θα δηλώσω την αλλαγή αυτή;

For SC = 1 To 4

[ChrisGT7]

Για δοκίμασε αυτόν τον κώδικα καλύτερα:

Option Explicit

Sub METAFORA()
    Dim SC As Byte
    Dim R1 As Long, R2 As Long
    Dim C1 As Long, C2 As Long
    
    Application.ScreenUpdating = False
    Range("DC3:DF" & Rows.Count).ClearContents
    
    For SC = 1 To 4
        R2 = 3
        C2 = 106 + SC
        For C1 = 2 + SC * 21 To 21 + SC * 21
            R1 = 3
            Do
                If Cells(R1, C1).Value = "" Then
                    R1 = 0
                Else
                    Cells(R2, C2).Value = Cells(R1, C1).Value
                    R1 = R1 + 1
                    R2 = R2 + 1
                End If
            Loop While R1 > 0
        Next
    Next
    
    Application.ScreenUpdating = True
End Sub

Δεν υπάρχει πρόβλημα να αλλάξεις το Τμήμα, μιας και δεν υπάρχει πλέον στον κώδικα.

Η For...To... δέχεται μόνο αριθμούς, οπότε δεν μπορείς να χρησιμοποιήσεις γράμματα.

[Immortal]

Καλημέρα!

Χρήστο έχω ενημερώσει τον κώδικα και λειτουργεί επίσης άψογα. Σε ευχαριστώ για τον χρόνο σου!

Όσον αφορά την χθεσινή μου ερώτηση:

Αν θελήσω να αλλάξω το 1 έως 4 σε Α Β Γ Δ; Είναι αυτό εφικτό; Και αν ναι, στο παρακάτω κομμάτι πως θα δηλώσω την αλλαγή αυτή;

For SC = 1 To 4

Είχα στο μυαλό μου πως επειδή θέλω να αντικαταστήσω τους αριθμούς με γράμματα δίπλα σε κάθε Section στο φύλλο, ότι θα έπρεπε να προσαρμοστεί και το παραπάνω κομμάτι του κώδικα.
Εν τέλει αντιλήφθηκα πως δεν παίζει ρόλο και πλέον λειτουργεί ακριβώς όπως χρειάζομαι!