VBA:使用 VLookUps 从值列表创建新工作簿
VBA: Creating new workbooks from list of values with VLookUps
在接触社区之前,我一直在搜索和学习有关 VBA 的所有信息。
我有一个 sheet 的工作簿,其中包含一个值列表。在另一个 sheet 中,该列表是其中一个单元格中的下拉列表。该单元格链接到数十个 vlookup 和公式以快速验证一些公司数据。
我一直在微调另一个 post 的宏,并让它从列表中复制值并保存到我想要的位置,并根据需要命名。我还没有得到它来重复这个过程......有什么建议吗?这是我到目前为止一直在搞乱的代码。
Sub create()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("GIW")
Set sh2 = Sheets("3A")
lr = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
For Each c In rng
Set wb = ActiveWorkbook
wb.Sheets.Add
wb.Sheets(1).Range("D10") = c.Value
wb.SaveAs c.Value & ".xlsx" = "C:\Users\ianc\Desktop\Exhibit 2 Data Validation.xlsx"
wb.Close False
Next
End Sub
我能看到的唯一问题是使用 ActiveWorkbook
。尝试将 wb 设置为您正在使用的工作簿的名称。
这是从录制的宏开始的首要技巧之一,您必须摆脱录制器在开始时使用特定的 ActiveSheet
和 ActiveWorkbook
引用名字。 VBA 这样表现更好。
Sub create()
Const FPATH As String = "C:\_Stuff\"
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Dim c As Range
Set sh1 = ThisWorkbook.Sheets("GIW")
lr = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
Set wb = ActiveWorkbook
wb.Sheets.Add before:=wb.Sheets(1)
For Each c In rng
wb.Sheets(1).Range("D10") = c.Value
wb.SaveCopyAs FPATH & c.Value & ".xlsx"
Next
wb.Close False
End Sub
在接触社区之前,我一直在搜索和学习有关 VBA 的所有信息。
我有一个 sheet 的工作簿,其中包含一个值列表。在另一个 sheet 中,该列表是其中一个单元格中的下拉列表。该单元格链接到数十个 vlookup 和公式以快速验证一些公司数据。
我一直在微调另一个 post 的宏,并让它从列表中复制值并保存到我想要的位置,并根据需要命名。我还没有得到它来重复这个过程......有什么建议吗?这是我到目前为止一直在搞乱的代码。
Sub create()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("GIW")
Set sh2 = Sheets("3A")
lr = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
For Each c In rng
Set wb = ActiveWorkbook
wb.Sheets.Add
wb.Sheets(1).Range("D10") = c.Value
wb.SaveAs c.Value & ".xlsx" = "C:\Users\ianc\Desktop\Exhibit 2 Data Validation.xlsx"
wb.Close False
Next
End Sub
我能看到的唯一问题是使用 ActiveWorkbook
。尝试将 wb 设置为您正在使用的工作簿的名称。
这是从录制的宏开始的首要技巧之一,您必须摆脱录制器在开始时使用特定的 ActiveSheet
和 ActiveWorkbook
引用名字。 VBA 这样表现更好。
Sub create()
Const FPATH As String = "C:\_Stuff\"
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Dim c As Range
Set sh1 = ThisWorkbook.Sheets("GIW")
lr = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
Set wb = ActiveWorkbook
wb.Sheets.Add before:=wb.Sheets(1)
For Each c In rng
wb.Sheets(1).Range("D10") = c.Value
wb.SaveCopyAs FPATH & c.Value & ".xlsx"
Next
wb.Close False
End Sub