Question

我有一张名为＆＃34; Invoice Temp＆＃34;的工作表，发票temp在L4上有一个下拉列表。修改此下拉列表会更新范围A1：J54中的单元格＆＃34; Invoice Temp＆＃34;

我尝试做的是让VBA滚动浏览L4中的下拉列表，并为每个值，将范围A1：J54复制到新工作簿中，并在L4值之后重命名工作表，并将其保存在文件夹下：c：/ folder a /

^那就是大局。我已经研究了如何让它循环并复制一个单元格，但我似乎在复制范围时遇到了问题。

列K具有L4的数据验证。

感谢您的帮助！

这是我得到的：

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

VBA Loop Through下拉，复制范围

0 个答案: