Copy filtered range, paste skip blanks

时间:2016-10-15 17:17:36

标签: excel vba excel-vba

I'm trying to filter a sheet, and copy the results to another sheet. Some columns contain formulas that I don't want to copy over, as the destination sheet is blank aside from those columns (filled with different formulas). I'm clearing the contents of these cells with a separate macro. Disclaimer; my knowledge of Excel VBA comes from recording macros, stackoverflow, and a girlfriend who codes, so this might look pretty rough.

When I copy an unfiltered range and paste it as values, skipping blanks, it works perfectly. Once I filter the range and repeat the same steps, it doesn't "skip blanks", and overwrites the formulas. Do I just need to create a helper sheet to paste the filtered range to, re-copy as a contiguous range, and then paste skipping blanks?

Below is my code, thanks in advance for the help.

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim LastRow As Long

Set wb1 = ActiveWorkbook
LastRow = Cells(Rows.Count, "F").End(xlUp).Row


Sheets("Selection & Execution").Activate
Set Sheet = ActiveSheet
Set rng1 = ActiveSheet.UsedRange.Find("Selected?", , xlValues, xlWhole)
    With Sheet
            .Unprotect 
            .Cells.EntireRow.Hidden = False
            .Cells.EntireColumn.Hidden = False
            .Range("A4:EA20000").SpecialCells(xlCellTypeFormulas).ClearContents
            .Range("3:3").AutoFilter Field:=rng1.Column, Criteria1:= _
                "<>", Operator:=xlAnd
            .Range("A4", "EA" & LastRow).SpecialCells(xlCellTypeVisible).Copy

    End With

wb1.Activate
Sheets("Selection & Execution").Activate
Set rng2 = ActiveSheet.UsedRange.Find("Employee Number", , xlValues, xlWhole)

If rng2.Offset(1, 0) = "" Then
rng2.Offset(1, -5).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=True, Transpose:=False
wb2.Close SaveChanges:=False

Else
rng2.End(xlDown).Offset(1, -5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
wb2.Close SaveChanges:=False
End If

0 个答案:

没有答案
相关问题