Question

我有一个宏，其工作原理如下：

我有一个工作簿，里面有四个标签， *索引 - 包含建筑信息列表（从A完成E开始总共5列，有些月可以有3行，其他月可能有100行 *模板 - 具有基本建筑信息的模板页面 *数据 - 清单 * B2 - 另一份清单

我需要宏做的是创建一个包含工作表“Template”“Data”和“B2”的新工作簿

新工作簿需要根据索引工作表中A列中包含的建筑物名称进行命名

然后我需要索引选项卡上的列表复制到每个新工作簿的模板选项卡上的单元格F2，F3，F4，F5，F6 F5（每个标题一个）

下面是可用的代码，但目前只预填充到新工作簿中模板工作表上的单元格F2

    Sub temp()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("Index") 'Edit sheet name
Set sh2 = Sheets("B2") 'Edit sheet name
Set sh3 = Sheets("Data") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
    For Each c In rng
        Sheets("Template").Copy 'Edit sheet name
        Set wb = ActiveWorkbook
        wb.Sheets(1).Range("F2") = c.Value
        sh2.Copy After:=wb.Sheets(1)
        sh3.Copy After:=wb.Sheets(2)
        wb.SaveAs c.Value & ".xlsx"
        wb.Close False
    Next
End Sub

非常感谢...我确信我已经完成了90％的完成工作

Answer 1

试试这个

Sub temp()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range, x as long
Set sh1 = Sheets("Index") 'Edit sheet name
Set sh2 = Sheets("B2") 'Edit sheet name
Set sh3 = Sheets("Data") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
x = 2
For Each c In rng
    Sheets("Template").Copy 'Edit sheet name
    Set wb = ActiveWorkbook
    wb.Sheets(1).Range("F" & x) = c.Value
    x = x + 1
    sh2.Copy After:=wb.Sheets(1)
    sh3.Copy After:=wb.Sheets(2)
    wb.SaveAs c.Value & ".xlsx"
    wb.Close False
Next
End Sub

VB宏用于创建新工作簿并从主工作表中预填充新工作簿

1 个答案: