[Γενικά] οριζοντια-καθετα

[ShortCuter]

Αρχική Δημοσίευση από dimzoozoo

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

Επισυνάπτω συνημμένο!

ΕΥΧΑΡΙΣΤΩ ΠΟΛΥ

Μαρια.

Γειά χαρά Μαρία.
Η λύση είναι στην αυτοματοποίηση. Αντίγραψε τον παρακάτω κώδικα και επικόλλησέ τον στον project explorer σου στο ανάλογο φύλλο. Τον εμφανίζεις με Alt+F11.
Προσοχή στο να αρχίζουν τα δεδομένα από το κελί Α1 και δεξιά από τα δεδομένα της πρώτης γραμμής και κάτω από αυτά της πρώτης στήλης να έχει κενά κελιά διότι θα αρχίσει να αντιγράφει ό,τι να 'ναι όπου να 'ναι. Είναι προγραμματισμένο να ξεκινά την επικόλληση αφήνοντας μια κενή στήλη δεξιά της στήλης που τελειώνουν τα δεδομένα.
Το πρόγραμμα δεν λειτουργεί σε εκδόσεις πριν τη 2007 διότι έχει hardcoded αριθμούς που αντιστοιχούν σε αυτήν την έκδοση.

Option Explicit

Sub Transposition()

Dim CountRows, CountCols, StartCoord, RowCounter

CountRows = Cells(1048576, 1).End(xlUp).Row
CountCols = Cells(1, 16384).End(xlToLeft).Column
StartCoord = CountCols + 2

For RowCounter = 1 To CountRows
    Range(Cells(RowCounter, 1), Cells(RowCounter, CountCols)).Copy
    Cells(1 + (RowCounter - 1) * CountCols, StartCoord).PasteSpecial Paste:=xlPasteAll, Operation:= _
    xlNone, SkipBlanks:= False, Transpose:=True
Next RowCounter

End Sub

Παιδιά εννοείται ότι εάν υπάρχει καλλίτερη, ταχύτερη, εξυπνότερη λύση την παραθέτουμε.

Αδάμ