Ορισμός ονομάτων Sheets από επιλεγμένα κελιά

by | Sep 24, 2020 | Excel, Microsoft Office, VBA

Χρησιμεύει για να ορίσουμε τα ονόματα Sheets από επιλεγμένα κελιά (στήλη).
Αν δεν υπάρχει το αντίστοιχο πλήθος των sheets, τότε τα δημιουργεί.
Αν ένα κελί δεν έχει περιεχόμενο (είναι κενό) τότε θα δώσει αριθμητική τιμή στο όνομα του Sheet (Δείτε 2ο παράδειγμα).

Επιλέγουμε τα κελιά πάνω στα οποία θα εφαρμοστεί ο κώδικας.
Alt+F11 για να ανοίξουμε τον VBA Editor
Insert Module από το Insert Menu
Κάνουμε paste τον παρκάτω κώδικα.

Τρέχουμε τον κώδικα.

Sub Cells2SheetNames()

Dim sheet As Worksheet
‘Mark active Sheet. Will Re-Activate
ActSheet = ActiveSheet.Name

Dim rng As Range
Set rng = Selection
activeCol = ActiveCell.Column
fromRow = rng.Row
toRow = rng.Row + rng.Rows.Count – 1

‘Start column. May Choose another one
cnt = 1

‘Calculate the number of sheets required
SheetsRequired = (toRow – fromRow) – Sheets.Count + cnt

‘Add the required number of Sheets
If SheetsRequired > 0 Then
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count), Count:=SheetsRequired)
End If

Worksheets(ActSheet).Activate

For i = fromRow To toRow
If Not IsEmpty(Cells(i, activeCol)) Then
Sheets(cnt).Name = Left(Cells(i, activeCol), 31)
Else
‘Sheets(cnt).Name = “-” + Trim(Str(cnt)) + “-”
Sheets(cnt).Name = Trim(Str(cnt))
End If
cnt = cnt + 1
Next i
End Sub

 

Παράδειγμα 1

Μετά την εκτέλεση του κώδικα

 

Παράδειγμα 2

Μετά την εκτέλεση του κώδικα