Code to Loop down Column and copy range to another worksheet

Cammandk · Jan 2, 2014

I have a worksheet (Sheet3). On this is a range - Z11:Z386. Certain cells in this column may equal "1".
Example: if Z11 = "1" then I need the code to copy AA11:AG11 to Sheet8 B3 (first data line)
The loop goes all way down to Z386 and copies any rows with "1" in to Sheet 8.

Any newly copied rows need to be added to the last entry made in Column B.

After the data is added to Sheet 8 I need it sorted by Col B then Col C the Col E

Thanks
DK.

Marc L · Jan 3, 2014

The faster and easy way : start to use a filter on the column Z range,
once filtered, copy visible cells using SpecialCells method …

Hui · Jan 3, 2014

You may also want to have a look at: http://chandoo.org/wp/2012/05/14/vba-move-data-from-one-sheet-to-multiple-sheets/

vijay.vizzu · Jan 3, 2014

Dear Cammandk

First let me confirm some details:
1. if Z11 = "1" then I need the code to copy AA11:AG11 to Sheet8 B3 (Is the range AA11:AG11 will be same for all during the loop?)
2.The loop goes all way down to Z386 and copies any rows with "1" in to Sheet 8 (In this line you are saying that the rows which are 1 mentioned to be copied to sheet 8, that means entire row which 1 is mentioned)

Please confirm which condition. You want to copy A11:AG11 if Z column has 1 mentioned or you want to copy the entire row wherever in Z column 1 is mentioned:

Cammandk · Jan 3, 2014

vijay.vizzu said:
Dear Cammandk

First let me confirm some details:
1. if Z11 = "1" then I need the code to copy AA11:AG11 to Sheet8 B3 (Is the range AA11:AG11 will be same for all during the loop?)
2.The loop goes all way down to Z386 and copies any rows with "1" in to Sheet 8 (In this line you are saying that the rows which are 1 mentioned to be copied to sheet 8, that means entire row which 1 is mentioned)

Please confirm which condition. You want to copy A11:AG11 if Z column has 1 mentioned or you want to copy the entire row wherever in Z column 1 is mentioned:

Hi Vijay
I need to copy only the range AA:AG on the row that has a "1".

Thanks
DK

Cammandk · Jan 7, 2014

Hui said:
You may also want to have a look at: http://chandoo.org/wp/2012/05/14/vba-move-data-from-one-sheet-to-multiple-sheets/

Can you suggest / point me in the direction of data from multiple sheets to one sheets.

I have Sheet1 / Sheet2 / Sheet3
The data range is in the same place in each sheet - potentially any row from D5 to D11
If in Column D the Row = "R" then I need to copy from that cell - six columns across and copy the data range to Sheet4 - adding any future data to the last data row already on that sheet.

Any help would be appreciated.

Thanks
DK

Smallman · Jan 8, 2014

CammandK

I would not mess around with moving a line at a time as the link suggests. I would take Mark L’s suggestion with the caveat that SpecialCells are not required with a filter. Excel will only copy the visible cells by default. To answer the question which seems to have morphed from Post 1 – 6 from a “1” to a curious “R” as the criteria and from 1 sheet to 3 sheets (sheets1-3) and from Sheet8 to Sheet4 for the output.

With the ambiguity in the post I have created some example coding which takes Columns A to G from Sheets 1-3 and stacks the data in Sheet4. Nice and simple, using Col D as the criteria, data starts in Row 1 – it will be up to you to adapt this for your own needs.

Code:

Option Explicit
 
Sub MoveMe()
    Dim sh As Worksheet
   
    For Each sh In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
        sh.Range("D1", sh.Range("D" & Rows.Count).End(xlUp)).AutoFilter 1, "R"
        sh.[a1].CurrentRegion.Offset(1).Copy Sheet4.Range("A" & Rows.Count).End(xlUp)(2)
        sh.[d1].AutoFilter
    Next sh
End Sub

Take care

Smallman

Cammandk · Jan 8, 2014

Smallman
Thanks for this - trying to adapt - where within the code are Columns A to G selected?

Thanks
DK

Smallman · Jan 8, 2014

That is the point you don't select anything with vba (with a very few exceptions). All you need to do is change your ranges and sheet names you should be able to adapt.

Take care

Smallman

Cammandk · Jan 8, 2014

I've got this working now - where the data is in consecutive rows - but on my sheets it won't be - when i tried this it only brings across the 1st date row from each sheet and then stops.

Is this possible to address.
thanks
DK

Smallman · Jan 8, 2014

The code brings back 6 columns of data. Not one as you suggest. You can copy a non consecutive range but you need to give out that coordinates. This is yet another departure from your original post.

Take care

Smallman

Cammandk · Jan 8, 2014

Thank you for you reply. As a newbie to this it's hard to always understand how specific the question/criteria needs to be - so apologies if the goalposts keep moving.
When you refer to give out the co-ordinates for a non consecutive range - what do you mean.
The values in my criteria column are will always be between D1:D300?

Thanks
DK

Smallman · Jan 8, 2014

Hi Cammandk

You said the ranges were not consecutive. Or maybe that was just my interpretation? Maybe the Dates are only showing because the criteria is not being met. You can step through each line of the code by pressing F8. This will allow you to see your data being filtered. IF the data is not getting filtered then there is a problem with your criteria (not the code). So do this first.

If this fails the best way for you to get a result is to dummy up a file and upload it. You will get swift and accurate assistance. Maybe not from me as it is very late down under. If no one else takes it up I will check your file in the morning.

Take care

Smallman

Cammandk · Jan 8, 2014

Hi Smallman

Demo file attached - Sheet 1 & 3 have non consecutive rows. Sheet 4 all consecutive.
When macro runs on Sheet5 it brings 1st matching row from Sheet 1 & Sheet 3 and all matching rows from Sheet4.
The criteria in "D" could be on any consecutive or non consecutive rows in "D".
I've added in the clear contents line because I want to be able to refresh the data and know it reflects the current values.

Thanks
DK

Smallman · Jan 8, 2014

Hi Commandk

Easily fixed.

Code:

Option Explicit

Sub MoveMe()
    Dim sh As Worksheet
      Sheet5.Range("A2:M300").ClearContents
    
    For Each sh In Sheets(Array("Sheet1", "Sheet3", "Sheet4"))
        sh.Range("D1", sh.Range("D" & Rows.Count).End(xlUp)).AutoFilter 1, "E"
        sh.Range("A2", sh.Range("M65536").End(xlUp)).Copy Sheet5.Range("A" & Rows.Count).End(xlUp)(2)
        sh.[d1].AutoFilter
    Next sh
End Sub

File attached to prove workings.

Take it easy

Smallman

Cammandk · Jan 8, 2014

Have tried and it does now work. However if a sheet does not contain the "Criteria" value it pulls in the header line into Sheet5

Thanks
DK

Smallman · Jan 8, 2014

DK

In that case then you just need a variable to capture the last row.

Code:

Option Explicit
 
Sub MoveMe()
    Dim sh As Worksheet
    Dim lw As Long
      Sheet5.Range("A2:M300").ClearContents
  
    For Each sh In Sheets(Array("Sheet1", "Sheet3", "Sheet4"))
        sh.Range("D1", sh.Range("D" & Rows.Count).End(xlUp)).AutoFilter 1, "E"
        lw = Range("A" & Rows.Count).End(xlUp).Row
        If lr > 1 Then
          sh.Range("A2", sh.Range("M65536").End(xlUp)).Copy Sheet5.Range("A" & Rows.Count).End(xlUp)(2)
        End If
        sh.[d1].AutoFilter
    Next sh
End Sub

Take care

Smallman

Cammandk · Jan 9, 2014

Can't get new code to work.
Does "lr" need to be defined as new variable or should this have been "lw".
Tried as "lw" but doesn't pull across any data. Then with the "lw" changed >1 to >0 - this pulled across records but when a sheet had not matching criteria it goes back to original issue of pulling in header sheet.

DK

Cammandk · Jan 11, 2014

Finally figured this out.
lr should be lw
lw = Range("A" & Rows.Count).End(xlUp).Row should be
lw = sh.Range("A" & Rows.Count).End(xlUp).Row

Smallman · Jan 12, 2014

Hi Cammandk

I appologise I did not see your response. I free texted the alterations into Chandoo. If I was to have a crack again;

Dim lw as long

Should have read;

Dim lr as long

This would be the full coding.

Code:

Option Explicit

Sub MoveMe()
    Dim sh As Worksheet
    Dim lr As Long
      Sheet5.Range("A2:M300").ClearContents
 
    For Each sh In Sheets(Array("Sheet1", "Sheet3", "Sheet4"))
        sh.Range("D1", sh.Range("D" & Rows.Count).End(xlUp)).AutoFilter 1, "E"
        lr = sh.Range("A" & Rows.Count).End(xlUp).Row
        If lr > 1 Then
          sh.Range("A2", sh.Range("M65536").End(xlUp)).Copy Sheet5.Range("A" & Rows.Count).End(xlUp)(2)
        End If
        sh.[d1].AutoFilter
    Next sh
End Sub

Thanks for sharing.

Take care

Smallman

Cammandk · Jan 12, 2014

Hi Smallman
Thanks for getting back.

The code is working really well and I've been able to adapt it do other things in my workbook.

One further request - is it possible to have 2 criteria for the autofilter - like "F" and "A". I've tried to get to work but obviously either not possible or I'm missing something.

DK.

Cammandk · Jan 12, 2014

Hi Smallman

Can you help me with the reverse of what you provided:
I've outlined in the attached worksheet.
Thanks
DK

Code to Loop down Column and copy range to another worksheet

Member

Excel Ninja

Excel Ninja

Member

Member

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Attachments

Excel Ninja

Attachments

Member

Excel Ninja

Member

Member

Excel Ninja

Member

Member

Attachments