VBA Excel基于单元格值自动生成用于递增单元格的新工作表
VBA Excel基于单元格值自动生成用于递增单元格的新工作表
提问于 2021-03-17 15:17:55
我想在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是否有机会根据单元格范围使用名称自动填充工作表？
Stack Overflow用户
回答已采纳
发布于 2021-03-17 16:03:36
这应该做你想要的，它从范围得到一个数组，将它转换成一个一维数组，然后制作工作表。
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/66676014
复制相关文章
相似问题
腾讯云开发者
