VBA Excel autopopulate new sheets based on the cell value for incrementing cells - excel

Question

I would like to auto-populate new sheets in Excel with their names based on the cell value. However, it won't be the value from one cell but from the list of cells in the row. The name of the first worksheet will be fetched from the 1st cell value, the name of the second worksheet from the 2nd cell value, and so on...
I defined the maximum range of these cells - 20 in the row, but not all of them will have the values. I want the new sheets to be created only from these cells, where value is provided.
I used the following code:
Sub Namedsheetsadding()
Dim wsr As Worksheet, wso As Worksheet
Dim i As Long, xCount As Long
Dim SheetName As String
Set wsr = ThisWorkbook.Sheets("Vetro Area Map 1")
SheetName = ThisWorkbook.Sheets("Frontsheet").Range("D122:D142") 'including empty cells either, but
not creating new sheets for them
For i = 1 To ActiveWorkbook.Sheets.Count
If InStr(1, Sheets(i).name, "Vetro") > 0 Then xCount = xCount + 1
Next
wsr.Copy After:=ActiveWorkbook.Sheets(wsr.Index - 1 + xCount)
ActiveSheet.name = "Vetro Area Map " & SheetName & xCount + 1
End Sub
Based on some solutions here:
VBA rename sheet based on cell value
http://excelexperts.com/vba-code-adding-new-sheet-based-cell-value
https://www.mrexcel.com/board/threads/vba-create-new-sheet-based-on-cell-data.740895
EXCEL VBA Dynamic Sheet Name according to a cell value - Not working when formula in the cell
which apply to one cell only
Possibly this is the reason, why I am getting:
Error: Type mismatch
for the following line:
SheetName = ThisWorkbook.Sheets("Frontsheet").Range("D122:D142") 'including empty cells either, but not creating new sheets for them
Is there any chance to make the sheet auto-population with names based on the cell range?

Answer 1

This should do what you are looking for,it gets an array from the range, converts it into a 1d array and then makes the sheets.
Sub Namedsheetsadding()
Dim wsr As Worksheet, wso As Worksheet
Dim i As Long, xCount As Long
Dim SheetNames As Variant 'This needs to be variant
Dim sheetname As Variant
Dim newsheet As Worksheet
Dim lr As Long
Set wsr = ThisWorkbook.Sheets("Vetro Area Map 1")
lr = ThisWorkbook.Sheets("Frontsheet").Cells(Rows.Count, 4).End(xlUp).Row 'Get last row
SheetNames = ThisWorkbook.Sheets("Frontsheet").Range("D122:D" & lr) 'including empty cells either, but not creating new sheets for them
SheetNames = Application.Transpose(Application.Index(SheetNames, , 1)) 'Converts the 2d array into a 1d array
For i = 1 To ActiveWorkbook.Sheets.Count
If InStr(1, Sheets(i).Name, "Vetro") > 0 Then xCount = xCount + 1
Next
For Each sheetname In SheetNames
wsr.Copy After:=ActiveWorkbook.Sheets(wsr.Index - 1 + xCount)
Set newsheet = Sheets(wsr.Index + xCount)
newsheet.Name = "Vetro Area Map " & sheetname
xCount = xCount + 1 'Preserve order of sheets from range
Next
End Sub

Answer 2

In answer to your question, YES, you can make sheets automatically named, but you'll need to handle your rules better. You're getting an error because you're trying to reference an array to a single string. I would recommend learning about arrays (Paul Kelly has some great stuff here), but there might be other ways to approach your specific issue.
If you're more familiar with Excel than VBA, you should try to make a cell formula rule that populates a SINGLE cell that should be the next name of a worksheet. If you can have a cell that will always have the proper name, then you can always have your code reference the same value.
Alternatively, you might want to use the VBA offset function, which is pretty easier for newer coders to comprehend.
See below as an example.
Sub makeNewWorksheets()
Dim wsr As Worksheet, wso As Worksheet
Dim i As Long, xCount As Long
Dim SheetName As String
Dim startTingCell As Range
Set startTingCell = Range("D122")
For i = 1 To ActiveWorkbook.Sheets.Count
If InStr(1, Sheets(i).Name, "Vetro") > 0 Then xCount = xCount + 1
Next
'Changes the cell being referenced by xCount
Set startTingCell = startTingCell.Offset(xCount, 0)
'helps explain what is happening. Delete after you've grasped what's up.
MsgBox "The cell that will be set to the name is " & startTingCell.Address & _
"with a value of " & startTingCell.Value
wsr.Copy After:=ActiveWorkbook.Sheets(wsr.Index - 1 + xCount)
ActiveSheet.Name = "Vetro Area Map " & startTingCell.Value
End Sub