Question

我有50个工作簿，我制作了一个代码，从主要的一行复制其中有相应名称的行到其他49个文件。问题是粘贴到49个目标文件 - 粘贴方法不起作用。错误是过滤器找不到名称的条目。我如何包含一行，如果过滤器在主文件中找不到名称，它将在文件中粘贴“没有条目”，其名称未找到？谢谢。

欢迎任何帮助。

Sub name1()

    Dim ws As Worksheet
    Dim rng As Range, rngA As Range, rngB As Range
    Dim LRow As Long
    Set ws = Sheets("name list")
    With ws
        LRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set rng = .Range("A1:M" & LRow)
        .AutoFilterMode = False
         With rng
            .AutoFilter Field:=12, Criteria1:="name1"
            Set rngA = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
         End With
        .AutoFilterMode = False
           With rng
            .AutoFilter Field:=13, Criteria1:="name1"
            Set rngB = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
           End With
        .AutoFilterMode = False
        rng.Offset(1, 0).EntireRow.Hidden = True
        Union(rngA, rngB).EntireRow.Hidden = False
    End With
End Sub

Sub name11()
    Dim lst As Long
    Dim rng As Range
    Dim i As Integer
    Set rng = Application.Intersect(ActiveSheet.UsedRange, Range("A:M"))
    rng.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Application.DisplayAlerts = False

    Workbooks.Open Filename:= _
        "\\HOFS\persons\name1.xlsm" _
        , UpdateLinks:=true

    With Sheets("tribute").Range("A" & Rows.Count).End(xlUp).Offset(1)
    '.PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues 
    End With

ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = False

    Windows("name list.xlsm").Activate 
    rng.Offset(1, 0).EntireRow.Hidden = False

End Sub

Sub TRANSFER_name1()

Call name1
Call name11

End Sub

在工作簿之间粘贴excel vba

0 个答案: