Macro to Copy, Paste & Filter into a different worksheet

shakeregg

New Member
Joined
Sep 2, 2018
Messages
39
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!!
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Hello Shakeregg,


See if the following code helps:-

Code:
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("A" & Rows.Count).End(xlUp).Row
         
Application.ScreenUpdating = False

ws.Range("A4:K" & lr).Sort ws.[K4], 1

        ws.Range("K3", ws.Range("K" & ws.Rows.Count).End(xlUp)).AutoFilter 1, "<" & 60
        Union(ws.Range("B4:C" & lr), ws.Range("K4:K" & lr)).Copy
        sh.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlValues
        ws.[K3].AutoFilter

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The code will filter values less than 60 in Column K of the Raw Data sheet and then transfer the data from Columns B, C and K to the LSQ sheet starting from Column B. The code also sorts (ascending) the Raw Data sheet (Columns A:K) based on Column K values before transferring the data.

I've assumed that both sheets have headings in row3 with data starting in row 4.

I hope that this helps.

Cheerio,
vcoolio.
 
Upvote 0
Thanks vcoolio!!

Could you offer further assistance if that’s ok??

When the macro is run it’s copying only the top row to LSQ. It’s also moving the top row in Raw Data to Row 1 from Row 4.

Any ideas??

Any help would be appreciated!
 
Upvote 0
Sorry vcoolio just reread your post and I noticed my mistake.

Would there be a way of filtering after pasting the information to the other worksheet Raw Data. So the cells are copied and remain fixed. Pasted into LSQ and the filtered?
 
Upvote 0
Sorry vcoolio just reread your post and I noticed my mistake.

Would there be a way of filtering after pasting the information to the other worksheet. So the cells are copied and remain fixed then Pasted into LSQ and then filtered?
 
Upvote 0
Hello Shakeregg,

By filtering I assume that you actually mean sort the data ascending once it is transferred to the LSQ sheet leaving the Raw Data sheet as is.
If so, please advise the number of columns in the LSQ sheet (A:K or A:M or B:K etc..)

Cheerio,
vcoolio.
 
Last edited:
Upvote 0
Hey Vcoolio,

Sorry yep sort lowest to highest once pasted into LSQ. Columns in LSQ are only 3..... B:D.

Thank you again!
 
Upvote 0
OK Shakeregg,

Let's try it as follows:-


Code:
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("A" & Rows.Count).End(xlUp).Row
         
Application.ScreenUpdating = False

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

End Sub

The bit in red font should sort the data in the LSQ sheet for you.

I hope that this helps.

Cheerio,
vcoolio.
 
Upvote 0
Hey VCoolio,

Cheers for this!

At the moment only one row of data if it meets the criteria (row 4) is being through to LSQ ...... any ideas??

Cheers again!
 
Upvote 0
Hello Shakeregg,

I'm not sure what's going on as I've tested the code a number of times in a mock-up of what I believe your workbook to look like and all is working just fine.

It would be best if you uploaded a sample of your file to a free file sharing site, such as Drop Box, and then post the link to your file back here. Make sure that the sample is an exact replica of your workbook and if the data is sensitive, then please use dummy data. A dozen or so rows of data will suffice. This will make it simpler to sort this out for you.

Cheerio,
vcoolio.
 
Upvote 0

Forum statistics

Threads
1,215,641
Messages
6,125,980
Members
449,276
Latest member
surendra75

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top