copy line to new sheet macro

Microsoft Excel 2003 (full product)
May 31, 2010 at 20:57:10
Specs: Windows XP
I was wondering if anyone here can help me.

what im trying to do is:

Create a macro to sort data line by line from a "Dump" worksheet to other existing worksheets. Lines will be sorted according to column B which has string values the same as the worksheet names.

Sample data:

1 Town-Area
2 Hamilton-Newcastle
3 Charlestown-Newcastle
4 Marricville-Sydney
5 bondi-Sydney
6 HamiltonA-Newcastle
7 CharlestownA-Newcastle
8 MarricvilleA-Sydney
9 bondiA-Sydney

So basically I want all lines with a value of "sydney" in collumn B to be sorted to an existing worksheet also named "sydney" The same for those with "Newcastle" in collumn B.

The below macro that i copied from another thread(thanks Humar) almost does what i need but it will only copy 1 line to each tab.

Can it be adjusted to copy all appropriate lines to each tab?

Thanks in advance for any assitance.



NOTE: the worksheet with all the data in it is named "Dump"

Public Sub MoveToTab()
Dim rngRow As Range
Dim rngCell As Range

On Error GoTo ErrHnd

'use All used rows except first, in 'Dump' Worksheet
With Worksheets("Dump").UsedRange.Offset(1, 0) _
.Resize(Worksheets("Dump").UsedRange.Rows.Count - 1, _
'loop through all rows
For Each rngRow In .Rows
'test if tab exists
On Error Resume Next
If Not Worksheets(rngRow.Range("B1").Text).Name <> "" Then
On Error GoTo ErrHnd
'No Tab of this name - so create one and copy row
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = rngRow.Range("B1").Text
rngRow.Copy Destination:=Worksheets(rngRow.Range("B1").Text).Range("A1")
On Error GoTo ErrHnd
'worksheet exists
'copy row to end of used range
rngRow.Copy Destination:=Worksheets(rngRow.Range("B1").Text).Range("A1") _
.Offset(Worksheets(rngRow.Range("B1").Text).UsedRange.Rows.Count, 0)
End If
Next rngRow
End With

Exit Sub

'error handler
End Sub

See More: copy line to new sheet macro

Report •

June 1, 2010 at 05:29:16
re: sorted to an existing worksheet also named "sydney"

Since the sheets already exist, you don't need the parts of Humar's code that creates the sheets. This code just copies/paste the rows to the proper sheet.

You used the "sorted". Do you want the data sorted after it is copied? I did not include code to do that. Let us know if you need that code also.

Option Explicit
Sub MoveToTab()
Dim lastDumpRow, lastTabRow, myCity As Integer
Dim citySheet As String
'Find last row in Dump Sheet
 lastDumpRow = Sheets("Dump").Range("B" & Rows.Count).End(xlUp).Row
'Loop through Dump sheet Rows
  For myCity = 2 To lastDumpRow
'Set Sheet name variable
  citySheet = Range("B" & myCity).Value
'Find current last row in each city sheet
  lastTabRow = Sheets(citySheet).Range("A" & Rows.Count).End(xlUp).Row + 1
'Copy/paste row from Dump to current city sheet
    Sheets("Dump").Range("B" & myCity).EntireRow.Copy _
     Destination:=Sheets(citySheet).Range("A" & lastTabRow)
End Sub

Report •

June 1, 2010 at 21:10:49

Thanks heaps DerbyDad03. Works well. Very much apreciated.

I dont need to sort at this stage but it would be good to have to code. If its not a trouble that would be great. Column A seems like a good place to start.

Am I able to specify where the code starts pasting? ie can it start pasting 15 rows down instead of on the second. Is it as simple as changing a value in the code? I've had a crack at it with no luck

Thanks again mate.

Report •

June 1, 2010 at 21:19:07
As written, the code pastes the copied rows into the next empty row in each sheet. In an empty sheet, that ends up being row 2, since Row 1 is first row, add 1 and you get 2.

In any case, if you want the data pasted into Row 15, put something in A14. The code will see row 14 as the last row with data and begin pasting in Row 15. The next time you run the code, it will pasted below whatever is the last row that contains data.

If you really need it to paste into Row 15 with nothing in A14, let me know.

Report •

Related Solutions

June 1, 2010 at 21:46:44
Love your work. Thanks heaps.

Report •

Ask Question