Copy row content to another sheet

T

tvanduzee

Board Regular
Joined
Mar 14, 2008
Messages
86
Hello

Right now I have some code that iterates through the cells of a column to find it's cell value. Then, based on the name that is in the cell, it creates a sheet by that name (if the name already exists, it jumps to the next cell).

After all the sheets are created, it will then iterate through the cells again and look for the name. Based on the cell contents (a name), it will copy the row of data to the worksheet for that person.

All this works great; without a hitch, however, it takes a long time to run (as you might imagine).

Is there a way for excel to find "All occurrences" of a person's name in a specified range, the associated row number and then just copy all that persons data all at once? Im thinking this would speed things up a bit. Right now it takes approximately 2 minutes to go through 125 records.

Any suggestions on this?
I will post the code I have if necessary

Thank you
Terry
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
tvanduzee,

Please post your macro code.

At the beginning of your posted code, enter the following without the four double quote marks:
"["code"]"


'Your code goes here.


At the end of your posted code, enter the following without the four double quote marks:
"["/code"]"


Have a great day,
Stan
 
Upvote 0
Terry

So you just want to create new sheets for each unique value and split the data out to them?

If so why not consider using advanced filter.

Something like this perhaps.
Code: 
Option Explicit
Sub DistributeRows()
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
Dim LastRowCrit As Long
Dim I As Long
    
    Set wsAll = Worksheets("All") ' change All to the name of the worksheet the existing data is on
    
    LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
    
    Set wsCrit = Worksheets.Add
    
    ' column G has the criteria eg project ref
    wsAll.Range("G1:G" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
    
    LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
    For I = 2 To LastRowCrit
    
        Set wsNew = Worksheets.Add
        wsNew.Name = wsCrit.Range("A2")
        wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
         CopyToRange:=wsNew.Range("A1"), Unique:=False
        wsCrit.Rows(2).Delete
        
    Next I
    
    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
    
End Sub
 
Upvote 0
Norie

Thank you for this solution. I did not know this could be done. In the past I have been just iterating through the sheet's cells and creating a sheet for each name, then going back and copying (row by row) through iterating through the records again.

Again
Thank you

Terry
 
Upvote 0
Hi Norie

Does this part of the code copy all rows for a specific user?

Code: 
LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
    For I = 2 To LastRowCrit
    
        Set wsNew = Worksheets.Add
        wsNew.Name = wsCrit.Range("A2")
        wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
         CopyToRange:=wsNew.Range("A1"), Unique:=False
        wsCrit.Rows(2).Delete
        
    Next I

Thank you
Terry
 
Upvote 0
Thanks for this solution... has just made me look fantastic to someone who used to manually sort over 35000 rows into separate sheets!
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Copy, paste, change name of file.
Replies
2
Views
103
Skyybot
Skyybot
L
  • Solved
VBA - Copy All Cells Highlighted from Conditional Formatting to Another Sheet
Replies
4
Views
180
luckee
L
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
1K
Micron
M
A
  • Solved
Copy Entire Workbook, save as sheet name with current date, hide all sheets except one, & attach to email
Replies
2
Views
611
Amo840812
A
L
  • Solved
VBA Replace All '/' in a sheet, except for formulas
Replies
4
Views
161
MARK858
MARK858

Forum statistics

Threads
1,224,517
Messages
6,179,240
Members
452,898
Latest member
Capolavoro009

Share this page

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