VBA循环通过下拉,复制范围

我有一个名为“发票温度”的表,发票的温度在L4上有一个下拉菜单。 修改此下拉列表更新“发票温度”范围A1:J54中的单元格

我想要做的是让VBA在L4中的下拉列表中进行滚动,对于每个值,将范围A1:J54复制到新的工作簿中,并在L4值后重命名该表,并将其保存到文件夹下:c:/文件夹a /

^这是大的图片。 我已经制定了如何让它循环和复制一个单元格,但我似乎有复制范围的问题。

列K具有L4的数据validation。

谢谢您的帮助!

这是我得到的:

Sub trial() Dim dvCell As Range Dim inputRange As Range Dim c As Range Dim i As Long Set dataSheet = Sheets("Invoice") Dim curSheetName As String curSheetName = LefdataSheet.Cells(i, "K"), 24) Call AddSheet(curSheetName) Set trgSheet = Sheets(targetSheetName) 'Which cell has data validation Set dvCell = Worksheets("Invoice").Range("L4") 'Determine where validation comes from Set inputRange = Evaluate(dvCell.Validation.Formula1) i = 1 'Begin our loop Application.ScreenUpdating = False For Each c In inputRange dvCell = c.Value dataSheet.Range("prototemp").Copy trgSheet.Range("A1").PasteSpecial Paste:=xlPasteValues trgSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats trgSheet.Range("A1").PasteSpecial Paste:=xlPasteFormulas trgSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths i = i + 1 Next c Application.ScreenUpdating = True End Sub Sub AddSheet(sheetName As String) 'Remove sheet if one already exist Application.DisplayAlerts = False On Error Resume Next Sheets(sheetName).Delete Err.Clear Application.DisplayAlerts = True 'Add sheet with designated name Sheets.Add(after:=Sheets(Sheets.Count)).Name = sheetName End Sub