Copying Rows between Worksheets Based on a Text Value

Hi Allen,
How do I modify your code above?

I have three worksheets in my excel workbook as shown below.

I have a workseet called Member List

Name Due Date Amount Paid

JohnDoe18 07-Feb-18 $124.00 Yes
JohnDoe19 08-Feb-18 $321.00 No <---From this record. Update to “Yes”
JohnDoe20 09-Feb-18 $333.00 No
JohnDoe1 10-Feb-18 $521.00 No
JohnDoe2 11-Feb-18 $333.00 No
JohnDoe3 12-Feb-18 $965.00 No
JohnDoe4 13-Feb-18 $145.00 No
JohnDoe5 14-Feb-18 $225.00 Yes
JohnDoe6 15-Feb-18 $336.00 No
JohnDoe7 16-Feb-18 $365.00 No
JohnDoe8 17-Feb-18 $124.00 Yes <---except this. I don’t want to copy this
JohnDoe9 18-Feb-18 $321.00 No
JohnDoe10 19-Feb-18 $333.00 No
JohnDoe11 20-Feb-18 $521.00 No
JohnDoe12 21-Feb-18 $333.00 No <---To this record
JohnDoe13 22-Feb-18 $965.00 No
JohnDoe14 23-Feb-18 $145.00 No
JohnDoe15 24-Feb-18 $225.00 No
JohnDoe16 25-Feb-18 $336.00 No
JohnDoe17 26-Feb-18 $365.00 No
JohnDoe18 27-Feb-18 $124.00 No
JohnDoe19 28-Feb-18 $321.00 No

Worksheet named “Pay Period”

FirstDate LastDate PayDay

02-Nov-17 15-Nov-17 30-Nov-17
16-Nov-17 29-Nov-17 14-Dec-17
30-Nov-17 13-Dec-17 28-Dec-17
14-Dec-17 27-Dec-17 11-Jan-18
28-Dec-17 10-Jan-18 25-Jan-18
11-Jan-18 24-Jan-18 08-Feb-18
25-Jan-18 07-Feb-18 22-Feb-18
08-Feb-18 21-Feb-18 08-Mar-18 <---Today is 09FEB18 and falls in this pay period
22-Feb-18 07-Mar-18 22-Mar-18
08-Mar-18 21-Mar-18 05-Apr-18
22-Mar-18 04-Apr-18 19-Apr-18
05-Apr-18 18-Apr-18 03-May-18
19-Apr-18 02-May-18 17-May-18
03-May-18 16-May-18 31-May-18
17-May-18 30-May-18 14-Jun-18
31-May-18 13-Jun-18 28-Jun-18
14-Jun-18 27-Jun-18 12-Jul-18

Worksheet “Report”

Name Due Date Amount

JohnDoe19 08-Feb-18 $321.00
JohnDoe20 09-Feb-18 $333.00
JohnDoe1 10-Feb-18 $521.00
JohnDoe2 11-Feb-18 $333.00
JohnDoe3 12-Feb-18 $965.00
JohnDoe4 13-Feb-18 $145.00
JohnDoe6 15-Feb-18 $336.00
JohnDoe7 16-Feb-18 $365.00
JohnDoe8 17-Feb-18 $124.00
JohnDoe9 18-Feb-18 $321.00
JohnDoe10 19-Feb-18 $333.00
JohnDoe11 20-Feb-18 $521.00
JohnDoe12 21-Feb-18 $333.00

I want to copy the records falling between 08FEB18 and 21FEB18 with a string “No” in the fourth column into the worksheet “Report” and update the “No” to “Yes” in “MemberList”.

Thank you very much.

Regards

Raghu

What if the data on the source sheet is linked? This works GREAT, except in that instance.

I'm dealing with a shared spreadsheet that multiple people periodically update as a candidate moves through an interview process.
Most have a personal copy of the shared spreadsheet on their computer. They copy/paste their data to the shared sheet using a linked copy/paste to allow the spreadsheet to auto track their updates.

What edits are needed to have this work in my example?

Hi
This works great, but what I need is to only copy the values from specific columns rather than the entire row. In my worksheet the criteria is in column U, but I'd only want the data from columns 1, 3, 8, 10, 12, 14 and 18 or A, C, H, J, L, N and R, rather than the entire row. Is that possible?
Thanks
Scott

This macro is awesome! I just have a problem though. When there are 5 rows with the value. Instead of copying those 5 rows into the other sheet, it just copies the first 5 rows of the original sheet into the other sheet.

This is what my code looks like:

Sub CopyRow()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("Supplier QA INVs")

j = 2
For Each c In Source.Range("C:C")
If c = "Supplier Quality" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("Maintenance")

j = 2
For Each c In Source.Range("C:C")
If c = "Maintenance" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("Compounding")

j = 2
For Each c In Source.Range("C:C")
If c = "Compounding" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("Warehouse Pre-Weigh")

j = 2
For Each c In Source.Range("C:C")
If c = "Warehouse Pre-Weigh" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("Callibration")

j = 2
For Each c In Source.Range("C:C")
If c = "Callibration" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("Facilities")

j = 2
For Each c In Source.Range("C:C")
If c = "Facilities" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("QA Labs")

j = 2
For Each c In Source.Range("C:C")
If c = "QA Labs" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("SMP")

j = 2
For Each c In Source.Range("C:C")
If c = "SMP" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("Batch Record")

j = 2
For Each c In Source.Range("C:C")
If c = "Batch Record" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("Fill & Pack")

j = 2
For Each c In Source.Range("C:C")
If c = "Fill & Pack" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("TBD")

j = 2
For Each c In Source.Range("C:C")
If c = "TBD" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("Quality Systems")

j = 2
For Each c In Source.Range("C:C")
If c = "QA" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("DV & RTV")

j = 2
For Each c In Source.Range("D:D")
If c = "Destruction Verification/RTV" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


Set Source = ActiveWorkbook.Worksheets("Open Investigations")
Set Target = ActiveWorkbook.Worksheets("For Alignment")

j = 2
For Each c In Source.Range("BJ:BJ")
If c = "y" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c

End Sub

This macro is amazing!

One query on it, i have formulas running in some of the cells i am copying over. Is it possible to instead paste just the values to the new cells rather than the formula?

Hi,

I have a question I hope someone can help with - using the above code works great for what I need with 1 exception is it possible to assign a destination column on the 2nd sheet? so for example I would like it to paste the data to Column L rather than column A?

MGR -
I changed the below Part of the code to

J = 2 ' Start copying to row 1 in target sheet

this moved it down 1 line on my destination sheet.

Hello

How do I add a header to my second sheet (where I am coping to), as the current code over writes anything in that sheet. Headers are the same in Sheet 1 and Sheet 2.

Thank you in advance for this.
Regards,
MGR

Hi Amy,
Try changing the check for the word , from this:-
If c = "yes" Then
To this:-
If InStr(c.Value, "Green", vbTextCompare) > 0 Then

Using your example, “Pink, Green, Blue” , InStr(1, c.Value, "Green", vbTextCompare) returns the position 7 , which is the first character of “Green” in the full string “Pink, Green, Blue” ( It starts looking from character position of 1 by virtue of me using first argument of 1. You can vary that as you wish )
If “Green” was not present, then a 0 would be returned

vbTextCompare makes it case insensitive, so it would also work for “Pink, green, Blue” . If you change vbTextCompare to vbBinaryCompare , then the code line will be case sensitive.

Alan

How can I modify this code so that it accepts any location for the desire value?
example:
Lets say I want the work to be "Green" instead of "Yes" but there more values than just "Green" on E so the cell will like this:

Pink, Green, Blue

I want the code to still pick up the "Green" even if it is in the middle and move that row, how can I do that?
Thank You

Peter, I am trying to make the macro below work but when I run it nothing happens. I added an initial Sub at the beginning, followed by a name for the macro. The first run errored out. The line with "Sheet1" in it was highlighted, so I changed the name in the macro to "Main," since that's what my first worksheet was named, and "Sheet2" to "NotInterested." Then I tried again and it didn't error, but nothing happened.

Thoughts?

Gary

Josh
Assuming that the Yes is in column D then:

Dim Source As Worksheet
Dim Target As Worksheet

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")

j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("D1:D1000") ' Do 1000 rows
If CStr(c) = "Yes" Then
Source.Range(Cells(c.Row, 1), Cells(c.Row, 3)).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub

Hi there All.

I please need some help, I have a workbook, Sheet 1 is called Main, Sheet 2 is called NotInterested, Sheet 3 is called Interested and Sheet 4 is called Pending, on main sheet I have all potential clients with info, column c4 to c1000 is a yes , no or possible column, I need to have the data from the entire row pulled through to the relevant sheets if the column 3 is entered as Yes/No or possible.

The rows a through to at the monet z are being used, and might include more info at a later stage as well, so I need the full row to be able to pull through in case it has any info.
Also if the headings can be pulled through.
Please can someone help me with this??

I am very new to excel and not quite sure on how to create any of these types of macros or rules etc.

Is there any way to modify this macro so that instead of copying ALL of the information in row C to the new worksheet, instead it will only copy the information in columns to the left of column C (columns A through C)?

For example, my information spans columns A through P. Instead of copying all of that information if the macro criteria is met, I only want the macro to display the information in to the left of Column C (the info in cells A through C and omitting the info in cells D through P).

I am working on a project and it seems that this site has close to what I need with a few modifications. I am looking to pull data from approx. 105 source worksheets (all formatted the same so data would be pulled from the same column on each worksheet). I am looking for specific text (REVIEW or EXPIRED). If these words are found, I would like to copy the data in the row to another worksheet named (STATUS). The data would be pulled from column K on the source worksheets. Anyone have any ideas on this.

Alright I solved my problem. Now if anyone can show me how to make this code cleaner or more concise that would be splendid.


Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Dim Target1 As Worksheet
Dim Target2 As Worksheet
Dim Target3 As Worksheet


Set Source = ActiveWorkbook.Worksheets("Sales Order Tracking Sheet")
Set Target = ActiveWorkbook.Worksheets("Technical Support - AHS")
Set Target1 = ActiveWorkbook.Worksheets("Technical Support - Other")
Set Target2 = ActiveWorkbook.Worksheets("AHS - Other")
Set Target3 = ActiveWorkbook.Worksheets("COC")

j = 5
For Each c In Source.Range("B1:B1000") ' Do 1000 rows
If c = "Lexmark/AHS" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
j = 5
For Each c In Source.Range("B1:B1000")
If c = "CSSD" Then
Source.Rows(c.Row).Copy Target1.Rows(j)
j = j + 1
End If
Next c
j = 5
For Each c In Source.Range("B1:B1000")
If c = "Cenovus" Then
Source.Rows(c.Row).Copy Target1.Rows(j)
j = j + 1
End If
Next c

j = 5
For Each c In Source.Range("B1:B1000")
If c = "AHS" Then
Source.Rows(c.Row).Copy Target2.Rows(j)
j = j + 1
End If
Next c

j = 5
For Each c In Source.Range("B1:B1000")
If c = "Acrodex Internal" Then
Source.Rows(c.Row).Copy Target2.Rows(j)
j = j + 1
End If
Next c

j = 5
For Each c In Source.Range("B1:B1000")
If c = "COC" Then
Source.Rows(c.Row).Copy Target3.Rows(j)
j = j + 1
End If
Next c

End Sub

My first shot at editing/ adding to the macro

Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Dim Target1 As Worksheet

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sales Order Tracking Sheet")
Set Target = ActiveWorkbook.Worksheets("Technical Support - AHS")
Set Target1 = ActiveWorkbook.Worksheets("Technical Support - Other")

j = 5 ' Start copying to row 1 in target sheet
For Each c In Source.Range("B1:B1000") ' Do 1000 rows
If c = "Lexmark/AHS" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
For Each c In Source.Range("B1:B1000")
If c = "CSSD" Then
Source.Rows(c.Row).Copy Target1.Rows(j)
j = j + 1
End If
Next c

End Sub

Hello, This macro is awesome for exactly what I'm doing. Can you help me understand how to have multiple copies of this macro working on different variables within the same worksheet?

I have data that I would like to have filtered to other different variables based on the 'c' label.

Thank you for your help

Morton - make sure you have a spare sheet labelled "Sheet2", else the macro can't find its "Target" sheet to paste the data...

Did anyone get an error on the Set Source line at top - "subscript out of range"
No clue what is going on.
thanks

Aloha, What a great resource this site is!

I'm having trouble with including more than one "If" value. This is what I've come up with, can anyone verify?

For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "yes" Or _
c = "yes2" Or _
c = "yes3" Then
Source.Rows(c.Row).Copy Target.Rows(j)

Also, I'd like to add a sort function based on values. I found this code (from this great website!):

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Range("A1").Sort Key1:=Range("A2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub

But how do I combine the two codes so that they run simultaneously on the same worksheet?

Thanks for sharing :))

@Simon,
The following code works:
----------------------------------
Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = ActiveWorkbook.Worksheets("Audits Records")
Set Target = ActiveWorkbook.Worksheets("Dealer Report")
j = 21
For R = 1 To 1000
If Source.Cells(R, 3) = Target.[B6] Then
Source.Rows(R).Copy Target.Rows(j)
j = j + 1
End If
Next R
End Sub
-------------------
--------------------------
Michael (Micky) Avidan
“Microsoft® Answers" - Wiki author & Forums Moderator
“Microsoft®” MVP – Excel (2009-2017)
ISRAEL

Hi,

I would be grateful for any assistance...

I have used the code in this thread to great success. I now want a specific cell B6 in the target worksheet to provide the search criteria for the search in the source sheet.

My addition to the: "If c =" ... (See below) doesn't appear to get off the ground.

Any suggestions?

Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

Set Source = ActiveWorkbook.Worksheets("Audits Records")
Set Target = ActiveWorkbook.Worksheets("Dealer Report")

j = 21
For Each c In Source.Range("c1:c1000")
If c = ActiveWorkbook.Worksheets("Dealer Report").Cells(6, 2) Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub

Is there anyone who can help me modify this to either:

(1)
Have a source sheet that has
a 515131 154156486 data
a 511588 254561531 data
b 849681 513515645 data
b 681321 351351351 data
c 687481 545456156 data
c 358484 351351351 data
...
...
...
...
...


and I want to be able to go to another sheet and copy paste text and have it find a matching entry from say column A and then pull each of the rows with it into another sheet. Either sheet2 or create a new one.

-OR-

Have a script that can go through and identify the unique items in column a and create a new worksheet and move all row data matching each of those unique entries to the newly created sheet.

Thank you

How to apply the same for multiple worksheets in different workbooks & set target is new workbook

@Becky

add:         Source.Rows(c.Row).EntireRow.Delete
just before: j = j + 1

I modified this to cut the data instead of copy. What do I need to add to then delete the blank rows?

Thanks

is there a way to modify the above code to insert starting at a specific row instead of pasting to the second sheet.

OR

is there a way to modify the above code to use countif to identify how many rows are needed and then isert them before copy and pasting to the second sheet.

This works but does not search for partial text
As you cannot use wild cards

Hi Allen, Any change i can only copy as values instead of formula?

Hi,
Wont this code
Source.Rows(c.Row).Copy Target.Rows(j)
copy the formulas / formats also ?

How to just copy the value of each rows in the source sheet to target sheet?

Also in case I have multiple worksheet (i.e. multiple source worksheets), say A,B,C etc and I need a summary sheet that includes all data (values only) in (i.e. one target sheet)

This is the simplest code I've ever met to copy and paste specific data from another sheet to another sheet. Thanks very much. It's very helpful. Hope you post more... =)

Hi,
I was reading some forums regarding this type of concern and I think this is the best that would actually help me with my concern. (Just starting to learn macro)

I have 2 sheets same workbook. sheet1 is named Main, and sheet2 is Appointments. The main sheet will be the source sheet and it has 16 columns and the rows are updated daily. Column "L" has a header "status". The important status that I need to detect is the word "Appointment".

What I am really trying to find out is how can all the rows that will contain the status Appointment be transferred to sheet 2.

**The main sheet is updated daily so is it possible that the appointment sheet also updates automatically whenever it detects a row is added on the main sheet with the status "Appointment".

I hope I described the concern well. Any help with this is highly appreciated.

Cheers,
Harold

Marian,
After filtering and then highlighting the data, from the ribbon
Home
Find and Select
Go to Special
Visible Cells Only

Now it will copy and paste WYSIWYG.

Thank you Ed- that makes perfect sense!

You have a knack for explaining things very well. You should be a teacher if you aren't already.

Thank you again!

Gary

Gary:
No problem answering your query.

Note that the formula in question has another "IF" component that will set it to "" when it exceeds the number of rows needed (the IF that is followed by a COUNTIF function).
The test you asked about is, in retrospect, unnecessary because of that test. The clause in question will set to blank all rows after the first row that evaluates the "IF" to blank. Of course, they'd return the "" anyway, as a result of the COUNTIF.
I think (but I am NOT sure) that the formula evaluates more efficiently with this additional test. That would come into play if you were working with a large block of data.

That formula, in English, does this:
If the cell above me is blank, I'm blank...
Otherwise, if the cell above me plus one is more than the number of times I'm needed, I'm blank...
Otherwise, I'm one more than the cell above me.

The way it finds how many times it is needed is by asking "how many times is the value in cell "B2" found in row "B" of the main data worksheet?"
Which is what is done by the "COUNTIF(Sheet1!B:B,B$2)"

Hope this clarifies. Happy to help, feel free to ask for more, if needed.

I avoid using xlCellTypeLastCell. Perhaps the potential issue reported here is no longer valid: http://www.rondebruin.nl/win/s9/win005.htm.

I've used array formulas in the past, but I find them unintuitive and difficult to debug. They can also be slow if you're processing many thousands of rows. I usually go for the VBA approach, but I guess it depends on your particular situation.

Oops, I made a mistake in copying the formula. It should read "IF(COUNTIF(Sheet1!D:D,B$2)<A3+1" I did have it right on my worksheet.

Thanks!

Gary

Thank you Ed! Wow! It seems to have worked, but now I'm trying to understand it.

If you don't mind, I'd like to ask a question about one of the formulas.

How does the formula on the first supporting worksheet, in column A, work? I can see that it increments as long as their is data matching the account number specified in column B, on the data worksheet, but can you walk through the pieces of the formula?

For example, first the formula looks at column A, the row above it, to see if it equals "". So it looks like that is just trying to determine if the row above this one is blank, which it won't be unless it's the second row after the last row. If it's the row after the last row the first condition won't make this cell blank, because the row above it isn't blank, but the second part of the formula will, although I don't quite understand "IF(COUNTIF(Sheet1!D:D,B$2)<A218=1" Can you explain this part of the formula for me?

Thanks again Ed for taking the time to put this together! This is very helpful!

Gary

I have tried using filtering to select only the data I want, but when pasting to the new worksheet and turning off the filtering, all of the data is there. I've tried being careful to paste special, values only, but it doesn't always work. If these were spreadsheets being used only by me, then it wouldn't be a problem but I'm doing this for the use of others. Should they turn off the filtering in the new worksheet, they would end up with all values again. i'm using Excel 2013.

Gary Lundblad:
I have a method that is hard to describe, but easier to use. In my explanation, I’ll assume you have 2500 rows of data (in columns “A” through “F”), and that row #1 is headings.
In your first worksheet, the one with the data, insert a column to the left of the table (a new column “A”). In cell “A2”, put:
=B2&TEXT(COUNTIF(B$1:B2,B2),"0000").
Copy down for all rows.

In cell “H1”, type this but don’t hit enter: =MAX(COUNTIF(B:B,B2:B2501))
This is an array formula, so hit “Ctrl-Shift-Enter” to create it. You should get a value that tells you the maximum number of rows the supporting worksheets will need. Note that value.
In the first supporting worksheet, put a “1” in cell A2 and the first account in cell B2 (I assume you copy the headings from the main worksheet). In A3 put
=IF(A2="","",IF(COUNTIF(Sheet1!B:B,B$2)<A2+1,"",A2+1))
This will give a counter for rows in the supporting data’s spreadsheet.
In cell “C2”, put:
=IF($A2="","",VLOOKUP($B2&TEXT($A2,"0000"),Sheet1!$A$1:$G$2501,3,0))
Copy that across to columns “D” through “G”. Edit those formulas to increment the “3” near the end by one in each column. So cell “G2” should say =IF(A2="","",VLOOKUP($B2&TEXT($A2,"0000"),Sheet1!$A$1:$G$2501,7,0))

Copy the formulas in cells B2 to G2 down to row 3, then copy all of row 3 down to the maximum-row found earlier. Viola!
You then copy this spreadsheet, and you only need to change the account in cell B2.
If calculation time slows, you can delete the blank rows from the supporting worksheets.

To be fancy, the formula below can be put in an unused cell on the supporting worksheets and it will show if the count of rows of data matches exactly to the main worksheet’s needs (formula assumes you have included a heading for column “A”):
=IF(COUNTIF(Sheet1!B:B,B2)=COUNTA(A:A)-1,"Ok",IF(COUNTIF(Sheet1!B:B,B2)>COUNTA(A:A),"Add "&COUNTIF(Sheet1!B:B,B2)-COUNTA(A:A)-1&" rows",COUNTA(A:A)-1-COUNTIF(Sheet1!B:B,B2)&" unneeded rows"))

Hope this works!

This looks like it could possibly be adapted to meet a need that I have. I have roughly 35 different general ledger accounts, each of which have their own worksheet. I want to be able to paste date into the first worksheet, run the macro, and have each row from the first worksheet copied to the appropriate worksheet based on the gl code referenced in column C. For example, one such gl code is 40100-000-01, and I have a worksheet named 40100, although I could change the name to 40100-000-01 if that would make things easier, or could remove the "-000-01" from the master data list before running the macro.

There are six columns of data, in columns A:F, and there could be as many as 2500 rows. Right now I have formulas on all 35 worksheets, that pull every row from the Data tab, and then I just filter each worksheet by the appropriate gl code for that worksheet. This works, but is a little more manual than I would prefer, and uses a ton of formulas.

Thank you!

I notice I use "Yes" instead of "yes". Please observe this difference.

1) Instead of using
Source.Range("E1:E1000"), why not use ...
Source.Range ("E1:E" & Cells.SpecialCells(xlCellTypeLastCell).Row)
That would remove an arbitrary value of 1000.


2) Instead of doing the loop, why don't you just turn on the filter, copy the cells, turn the filter off, and paste to the new area? ...

Source.Cells.AutoFilter Field:=5, Criteria1:="=Yes", Operator:=xlAnd
'Here, 'Field:=5' means column 'E'

Source.Range("A1:" & Cells.SpecialCells(xlCellTypeLastCell).Address).Copy

Source.Cells.AutoFilter 'Turn off autofilter

Worksheets("TargetWorkSheetName").Select
Range("A" & Range("A" & Range("C1048576").End(xlUp).Row + 1).PasteSpecial