VBA - Copy only certain filtered columns without header to the last row of another sheet

%3CLINGO-SUB%20id%3D%22lingo-sub-1049294%22%20slang%3D%22en-US%22%3EVBA%20-%20Copy%20only%20certain%20filtered%20columns%20without%20header%20to%20the%20last%20row%20of%20another%20sheet%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1049294%22%20slang%3D%22en-US%22%3E%3CP%3EHi%20All%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ECould%20somebody%20please%20help.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20am%20trying%20to%20find%20a%20VBA%20code%20that%20would%20allow%20to%20do%20the%20below%3A%3C%2FP%3E%3CP%3E-%20Filter%20column%20H%20to%20keep%20only%20Completed%20lines%20in%20Sheet1%3C%2FP%3E%3CP%3E-%20Copy%20filtered%20rows%20for%20columns%20F%20to%20H%20without%20Header%3C%2FP%3E%3CP%3E-%20Paste%20data%20to%20last%20row%20of%20Sheet2%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20have%20attached%20the%20worksheet%20for%20more%20clarity.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EMany%20thanks%20in%20advance%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1049294%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1049351%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20-%20Copy%20only%20certain%20filtered%20columns%20without%20header%20to%20the%20last%20row%20of%20another%20sheet%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1049351%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F377332%22%20target%3D%22_blank%22%3E%40nathsm%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPlease%20give%20this%20a%20try...%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-markup%22%3E%3CCODE%3ESub%20CoypFilteredData()%0ADim%20wsData%20%20%20%20%20%20As%20Worksheet%0ADim%20wsDest%20%20%20%20%20%20As%20Worksheet%0ADim%20lr%20%20%20%20%20%20%20%20%20%20As%20Long%0A%0AApplication.ScreenUpdating%20%3D%20False%0A%0ASet%20wsData%20%3D%20Worksheets(%22Sheet1%22)%0ASet%20wsDest%20%3D%20Worksheets(%22Sheet2%22)%0A%0Alr%20%3D%20wsData.Cells(Rows.Count%2C%20%22F%22).End(xlUp).Row%0A%0AIf%20wsData.FilterMode%20Then%20wsData.ShowAllData%0A%0AWith%20wsData.Rows(1)%0A%20%20%20%20.AutoFilter%20field%3A%3D8%2C%20Criteria1%3A%3D%22Completed%22%0A%20%20%20%20If%20wsData.Range(%22H1%3AH%22%20%26amp%3B%20lr).SpecialCells(xlCellTypeVisible).Cells.Count%20%26gt%3B%201%20Then%0A%20%20%20%20%20%20%20%20wsData.Range(%22F2%3AH%22%20%26amp%3B%20lr).SpecialCells(xlCellTypeVisible).Copy%20wsDest.Range(%22A%22%20%26amp%3B%20Rows.Count).End(3)(2)%0A%20%20%20%20%20%20%20%20wsDest.UsedRange.Borders.ColorIndex%20%3D%20xlNone%0A%20%20%20%20%20%20%20%20wsDest.Select%0A%20%20%20%20End%20If%0A%20%20%20%20.AutoFilter%20field%3A%3D8%0AEnd%20With%0AApplication.ScreenUpdating%20%3D%20True%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EClick%20the%20button%20called%20%22Copy%20Filtered%20Data%22%20on%20Sheet1%20in%20the%20attached%20to%20run%20the%20code.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1049368%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20-%20Copy%20only%20certain%20filtered%20columns%20without%20header%20to%20the%20last%20row%20of%20another%20sheet%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1049368%22%20slang%3D%22en-US%22%3E%3CP%3EThank%20you%20so%20much%20..this%20works%20perfectly%20%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F394231%22%20target%3D%22_blank%22%3E%40Subodh_Tiwari_sktneer%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1049386%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20-%20Copy%20only%20certain%20filtered%20columns%20without%20header%20to%20the%20last%20row%20of%20another%20sheet%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1049386%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F377332%22%20target%3D%22_blank%22%3E%40nathsm%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EYou're%20welcome!%20Glad%20it%20worked%20as%20desired.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPlease%20take%20a%20minute%20to%20accept%20the%20post%20with%20proposed%20solution%20as%20a%20Best%20Response%2FAnswer%20to%20mark%20your%20question%20as%20Solved.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1649808%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20-%20Copy%20only%20certain%20filtered%20columns%20without%20header%20to%20the%20last%20row%20of%20another%20sheet%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1649808%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F394231%22%20target%3D%22_blank%22%3E%40Subodh_Tiwari_sktneer%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EHello%20Subodh%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThank%20you%20for%20this%20code%2C%20it%20worked%20for%20me%20great.%20I%20have%20one%20question%20on%20this%2C%20what%20would%20the%20code%20be%20if%20I%20wanted%20to%20copy%20the%20selected%20cells%20and%20paste%20special%20values%20instead%20of%20just%20paste%3F%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThank%20you%20for%20your%20time.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1650270%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20-%20Copy%20only%20certain%20filtered%20columns%20without%20header%20to%20the%20last%20row%20of%20another%20sheet%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1650270%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F787478%22%20target%3D%22_blank%22%3E%40Carl_Stephens%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EIdeally%20you%20should%20have%20opened%20a%20New%20Question.%3C%2FP%3E%3CP%3EBut%20to%20give%20you%20an%20idea%2C%20you%20may%20try%20something%20like%20this...%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3ESourceRng.Copy%20%20'Copy%20the%20Source%20Range%0ADestRng.PasteSpecial%20xlPasteValues%20%20'Paste%20copied%20range%20as%20Values%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E
Highlighted
New Contributor

Hi All,

 

Could somebody please help.

 

I am trying to find a VBA code that would allow to do the below:

- Filter column H to keep only Completed lines in Sheet1

- Copy filtered rows for columns F to H without Header

- Paste data to last row of Sheet2 

 

I have attached the worksheet for more clarity.

 

Many thanks in advance 

 

5 Replies
Highlighted

@nathsm 

Please give this a try...

Sub CoypFilteredData()
Dim wsData      As Worksheet
Dim wsDest      As Worksheet
Dim lr          As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")

lr = wsData.Cells(Rows.Count, "F").End(xlUp).Row

If wsData.FilterMode Then wsData.ShowAllData

With wsData.Rows(1)
    .AutoFilter field:=8, Criteria1:="Completed"
    If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        wsData.Range("F2:H" & lr).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & Rows.Count).End(3)(2)
        wsDest.UsedRange.Borders.ColorIndex = xlNone
        wsDest.Select
    End If
    .AutoFilter field:=8
End With
Application.ScreenUpdating = True
End Sub

 

Click the button called "Copy Filtered Data" on Sheet1 in the attached to run the code.

 

 

Highlighted
Highlighted

@nathsm 

You're welcome! Glad it worked as desired.

 

Please take a minute to accept the post with proposed solution as a Best Response/Answer to mark your question as Solved.

Highlighted

@Subodh_Tiwari_sktneer 

 

Hello Subodh,

 

Thank you for this code, it worked for me great. I have one question on this, what would the code be if I wanted to copy the selected cells and paste special values instead of just paste?

 

Thank you for your time.

Highlighted

@Carl_Stephens 

Ideally you should have opened a New Question.

But to give you an idea, you may try something like this...

 

SourceRng.Copy  'Copy the Source Range
DestRng.PasteSpecial xlPasteValues  'Paste copied range as Values