使用 VBA 粘贴到多张纸上

Question

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

Sub List_creator()

Sheets("ALL Scheme Derivatives").Select
ActiveSheet.Range("$A:$Q944").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:$A47980").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 中，并且当前作为模板存储在名为 'Helper' 的工作表中在单元格 A2: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 粘贴到多张纸上

Pasting onto multiple sheets with VBA

excel

vba

paste