Question

我有一个宏，它当前查看一个数组，从数组中删除重复项并创建一个包含其余值的列表。宏然后获取此列表中的值并在Excel文件中为每个条目插入一个新工作表（请参见下文）

Sub List_creator()

Sheets("ALL Scheme Derivatives").Select
ActiveSheet.Range("$A$1:$Q$64944").AutoFilter Field:=9, Criteria1:=Array( _
    "A - Mini", "B - Supermini", "C - Lower Medium", "D - Upper Medium", _
    "E - Executive", "G - Specialist Sports", "H - MPV", "I - 4 x 4", "Y - LCV", "="), _
    Operator:=xlFilterValues
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("List").Select
Sheets("List").Name = "List"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$1047980").RemoveDuplicates Columns:=1, Header:= _
    xlNo


Dim ws As Worksheet
Dim Ki As Range
Dim ListSh As Range

With Worksheets("List")
    Set ListSh = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

On Error Resume Next
For Each Ki In ListSh
    If Len(Trim(Ki.Value)) > 0 Then
        If Len(Worksheets(Ki.Value).Name) = 0 Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Ki.Value
         ActiveSheet.[a1] = ActiveSheet.Name
        End If
    End If
Next Ki

End Sub

对于每个新创建的工作表，我都有一些我希望粘贴的项目。这些数据需要粘贴到单元格A2中，并且当前存储为单元格A2中名为“Helper”的工作表中的模板： M91。如何修改我的VBA以执行此额外任务？谢谢。

编辑：Gipadm你的答案很完美，谢谢你。

Answer 1

喜欢这个吗？

On Error Resume Next
For Each Ki In ListSh
    If Len(Trim(Ki.Value)) > 0 Then
        If Len(Worksheets(Ki.Value).Name) = 0 Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Ki.Value
            ActiveSheet.[a1] = ActiveSheet.Name
            'Copy from sheet Helper
            Sheets("Helper").Range("A2:M91").Copy Destination:=ActiveSheet.Range("A2")
        End If
    End If
Next Ki

使用VBA

1 个答案: