Macro to Copy, Paste & Filter into a different worksheet

[shakeregg]

Hey all,

Hopefully someone will be able to help!

I have digits ranging from 0 - 100 in K4:K60 in a worksheet called ‘Raw Data’. There is also written contents in B4:B60 and C4:C60 in the same worksheet (Raw Data). What I am trying to do is identify any digits in Column K that are under 60 and copy and paste the contents of this cell along with the equivalent B & C cells to another worksheet called LSQ.

For example, if K6 = 55 then I would like B6, C6 & K6 to be copied and pasted to LSQ. K12 = 42 then B12, C12 & K12 would be copied and pasted etc.

Column B contents from ‘Raw Date’ to be pasted in Column B4 onwards in LSQ.
Column C contents from’Raw Data’ to be pasted in Column C4 onwards in LSQ.
Column K digits from ‘Raw Data’ to be pasted in Column D4 onwards in LSQ.

Ideally I would like Column D in LSQ to be automatically filtered low to high.

Hopefully this makes sense and apologies if it doesn’t!

Any help would be really appreciated!!

 

[shakeregg]

Hey VCoolio.................. here's the link sorry for the delay in responding! It's a mock copy of the actual spreadsheet but it accurately translates.

https://www.dropbox.com/s/rxlxsz3l30u0kew/Test.xlsm?dl=0

So ideally when the macro runs...............hopefully what should happen is for any scores (in K) under 60........... B,C & K will be copied over to LSQ and then be sorted lowest to hightest.

Cheers again!

 

[vcoolio]

Hello Shakeregg,

Two little alterations to the code should do it for you:-

Sub Test()

        Dim ws As Worksheet: Set ws = Sheets("Raw Data")
        Dim sh As Worksheet: Set sh = Sheets("LSQ")
        Dim lr As Long: lr = ws.Range("[COLOR=#ff0000]B[/COLOR]" & Rows.Count).End(xlUp).Row
         
Application.ScreenUpdating = False

        ws.Range("K4", ws.Range("K" & ws.Rows.Count).End(xlUp)).AutoFilter 1, "<" & 60
        Union(ws.Range("B5:C" & lr), ws.Range("K5:K" & lr)).Copy
        sh.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlValues
        ws.[[COLOR=#ff0000]K4[/COLOR]].AutoFilter
        sh.Range("B5", sh.Range("D" & sh.Rows.Count).End(xlUp)).Sort sh.[D5], 1
        
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The bits in red font are the alterations.
With the lr declaration, I had assumed that you were using Column A in the Raw Data sheet.
The "filter off" is now set on K4 not K3.

I hope that this helps.

Cheerio,
vcoolio.

 

[shakeregg]

it's like spreadsheet magic................... thank you!!

just checking is there anyway that the old contents in LSQ can be deleted or if not written over?

 

[vcoolio]

Hello Shakeregg,

Another addition as follows (in blue this time) should take care of that:-

Sub Test()

        Dim ws As Worksheet: Set ws = Sheets("Raw Data")
        Dim sh As Worksheet: Set sh = Sheets("LSQ")
        Dim lr As Long: lr = ws.Range("B" & Rows.Count).End(xlUp).Row
         
Application.ScreenUpdating = False
        
        [COLOR=#0000ff]sh.[B4].CurrentRegion.Offset(1).ClearContents[/COLOR]
        ws.Range("K4", ws.Range("K" & ws.Rows.Count).End(xlUp)).AutoFilter 1, "<" & 60
        Union(ws.Range("B5:C" & lr), ws.Range("K5:K" & lr)).Copy
        sh.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlValues
        ws.[K4].AutoFilter
        sh.Range("B5", sh.Range("D" & sh.Rows.Count).End(xlUp)).Sort sh.[D5], 1
        
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Test it all in a copy of your worbbook first.

Cheerio,
vcoolio.

 

[shakeregg]

Works a treat!

Thank you Vcoolio!! Really appreciate your help!

 

[vcoolio]

You're welcome Shakeregg.
I'm glad that I was able to help.

Cheerio,
vcoolio.