excel - VBA Excel根据单元格值自动填充新工作表以增加单元格

Question

我想根据单元格值在 Excel 中使用它们的名称自动填充新工作表。但是，它不是来自一个单元格的值，而是来自行中的单元格列表。第一个工作表的名称将从第一个单元格值中获取，第二个工作表的名称将从第二个单元格值中获取，依此类推...
我定义了这些单元格的最大范围 - 行中的 20 个，但并非所有单元格都有值。我希望仅从提供值的这些单元格中创建新工作表。

我使用了以下代码:

 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

基于这里的一些解决方案:

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

仅适用于一个单元格
可能这就是我得到的原因:
错误:类型不匹配
对于以下行:

  SheetName = ThisWorkbook.Sheets("Frontsheet").Range("D122:D142")  'including empty cells either, but not creating new sheets for them

是否有机会根据单元格范围使用名称自动填充工作表？

Answer 1

这应该可以满足您的要求，它从范围中获取一个数组，将其转换为一维数组，然后制作表格。

 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