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 根据单元格值重命名工作表
• 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 根据单元格值的动态工作表名称 - 当单元格中的公式时不起作用

仅适用于一个单元格

可能这就是我得到的原因：

错误：类型不匹配

对于以下行：

  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

Answer 2

在回答您的问题时， YES的，您可以使工作表自动命名，但您需要更好地处理您的规则。 您收到错误是因为您试图将数组引用到单个字符串。 我建议了解 arrays （ Paul Kelly在这里有一些很棒的东西），但可能还有其他方法可以解决您的具体问题。

如果您对 Excel 比 VBA 更熟悉，您应该尝试制定一个单元格公式规则来填充一个应该是工作表的下一个名称的单个单元格。 如果您可以拥有一个始终具有正确名称的单元格，那么您始终可以让您的代码引用相同的值。

或者，您可能想要使用VBA 偏移量 function ，这对于新的编码人员来说更容易理解。

请参阅下面的示例。

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