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

Τα περιεχόμενα των κελιών πρέπει να έχουν μοναδικές τιμές και αυτές δεν πρέπει να έχουν ήδη χρησιμοποιηθεί ως ονόματα των Sheets.

Επιλέγουμε τα κελιά πάνω στα οποία θα εφαρμοστεί ο κώδικας.
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

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