将过滤后的数据从一个工作表复制并粘贴到另一个工作表

时间:2021-06-15 14:07:52

标签: excel vba

我是宏的新手。我有下面的代码,我试图从一张工作表中复制一些过滤后的数据,最后粘贴到另一个工作表中,但在粘贴步骤中出错。我不知道如何纠正。有人可以帮我解决这个问题吗?

Sub MyTest()
    Dim ws1 As Worksheet        
    Dim ws2 As Worksheet       
    Dim i As Long        
    Dim j As Long        
    Dim LastRow As Long        
    Dim r As Long        
    Dim str As String        
    Dim lRow As Long
    
    Application.ScreenUpdating = False
    
    Set ws1 = Sheets("Sheet2")        
    Set ws2 = Sheets("Sheet1")        
    lr1 = Cells(Rows.Count, 3).End(xlUp).Row        
    lr2 = Cells(Rows.Count, 2).End(xlUp).Row
    
    For r = lr1 To 5 Step -1        
        ws2.Activate        
        str = ws2.Cells(r, "C")        
        i = Application.WorksheetFunction.CountIf(ws1.Columns(1), str)
    
        If i > 1 Then ws2.Rows(r + 1 & ":" & r + i - 1).Insert 
   
        ws2.Range(Cells(r, "C"), Cells(r + i - 1, "C")) = str        
        ws2.Activate        
        ws2.Range("$A$4:$W$4").AutoFilter Field:=3, Operator:=xlFilterValues, Criteria1:=str        
        ws1.Activate        
        ws1.Range("$A$1:$D$1").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria1:=str
        ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 2).Select        
        Range(Selection, Selection.End(xlToRight)).Select        
        Range(Selection, Selection.End(xlDown)).Select        
        Selection.SpecialCells(xlCellTypeVisible).Copy        
        ws2.Activate        
        ws2.Range("$A$4:$W$4").AutoFilter Field:=3, Operator:=xlFilterValues, Criteria1:=str
        ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 8).Select        
        Selection.PasteSpecial Paste:=xlPasteValues        
        Application.CutCopyMode = False     
    Next r  
End Sub

0 个答案:

没有答案