excel copying data into mulitple tabs

Microsoft Office 2010 home and student
November 25, 2010 at 11:04:42
Specs: Windows Vista, 1.7, 3GB
I have a worksheet with Excel 2010 with columns ITEM, AMOUNT, DATE, ADDITIONAL INFORMATION. Now under ITEM there is 200 Rows, but only 5 different categories, such a 1, 2, 3, 4, 5. i have them color coated. I want to sort 1, 2, 3, 4, 5 into there own seperate tab. I have the original worksheet tab called WORK, and made 5 other tabs called 1, 2, 3, 4, 5. I was wondering if you could tell me how to sort all the information into each tab. thank you

See More: excel copying data into mulitple tabs

Report •


#1
November 25, 2010 at 11:46:39
Try this in a back-up copy of your workbook since macros can not be undone.

Option Explicit
Sub CopyRows()
Dim lastRw, srcRw, dstRw, myShts As Integer
Dim dstSht As String
'Copy Column Headings to each sheet
  For myShts = 2 To 6
    Sheets("Work").Rows(1).EntireRow.Copy _
      Destination:=Sheets(myShts).Range("A1")
  Next
'Determine last Row in Sheet("Work") Column A
  lastRw = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
''Loop to copy rows to specific sheets
    For srcRw = 2 To lastRw
'Determine destination sheet name
     dstSht = Sheets("Work").Range("A" & srcRw)
'Determine next empty row in destination sheet
     dstRw = Sheets(dstSht).Range("A" & Rows.Count).End(xlUp).Row + 1
'Copy Row
      Rows(srcRw).EntireRow.Copy _
       Destination:=Sheets(dstSht).Range("A" & dstRw)
    Next
End Sub

Posting Tip: Before posting Data or VBA Code, read this How-To.


Report •

#2
November 25, 2010 at 13:58:11
so how do i input this or use it?

Report •

#3
November 25, 2010 at 17:42:59
1 - Open a back up copy of your workbook.

2 - Press Alt-F11 to open the VBA editor.

3 - Choose Insert...Module and a new pane will open

4 - Copy/Paste the code from my post into that pane.
----- Copy everything starting from Option Explicit to End Sub
----- Make sure that all lines are either Green (Comments, which start with an apostrophe) or Black. If you see any Red, you copied/pasted something incorrectly. It should look just like my post, except that some lines will be green.

5 - To run the code from the VBA editor, place your cursor anywhere within the code and click the little Green arrow under Debug or press F5

6 - To run the code from within the workbook, choose View...Macros...Click on CopyRows and click Run.

7 - You can also assign the macro to a button or shape in your workbook. Google around for instructions on how to do that.

8 - The workbook must be saved as a .xlsm file type in order for macros to be enabled.

Posting Tip: Before posting Data or VBA Code, read this How-To.


Report •

Related Solutions

#4
November 26, 2010 at 10:59:58
Hey, when i hit he green play it says run-time error '9' subscript out of range
there are no red...but there is blue!


Report •

#5
November 26, 2010 at 19:30:55
Since I can't see your workbook from where I'm sitting, I can only ask some questions to see if we can determine the cause of the error.

A "Subscript out of range" error is typically caused when the code can't find the named object it is looking for. In the code I offered the only named objects we are looking for are sheets with names that match your ITEM categories, so I suspect the problem is with your sheet names.

You said you had a sheet named Work and 5 other sheets with names that match the 5 categories, right?

I am assuming a few things:

1 - "Work" is the first worksheet in your workbook.
2 - The ITEM categories are in Column A of the Work sheet, starting A2
3 - The five other worksheets have names that match the categories exactly, letter for letter, space for space. No leading spaces, no trailing spaces, no extra characters.

e.g. If you have the word Books somewhere in Column A on the Work sheet, then you have a sheet named Books. The uses the values from Works Column A as sheet names, so if you don't have exact matches, then the code would throw up that error when it tries to paste something into a sheet that doesn't exist.

Assuming all of the above is correct, try this:

Put the cursor in the code and then instead of clicking the green Run (it's Run, not Play) arrow, hit F8 to single step through the code. Each time you hit F8, the next line to be executed will turn yellow. Keep pressing F8 and tell me what line was yellow just before the next F8 caused the error to pop up.

My guess is that one of the sheet names doesn't match one of your categories.

Posting Tip: Before posting Data or VBA Code, read this How-To.


Report •

#6
November 26, 2010 at 20:30:30
ok thanks i got it. works 100%....2 question.
1) Can I insert 2 rows in row 1 and 2 to put title, without screwing this up?
2) will the changes be automatically be changed if i enter new information thanks.

Report •

#7
November 26, 2010 at 20:38:58
re"1) Can I insert 2 rows in row 1 and 2 to put title...?"

This version copies 2 rows for the Column labels and then copies data starting in Row 3.

re: "2) will the changes be automatically be changed if i enter new information"

I'm not sure what you mean by "will the changes be automatically be changed".

Option Explicit
Sub CopyRows()
Dim lastRw, srcRw, dstRw, myShts As Integer
Dim dstSht As String
'Copy Column Headings to each sheet
  For myShts = 2 To 6
    Sheets("Work").Rows("1:2").EntireRow.Copy _
      Destination:=Sheets(myShts).Range("A1")
  Next
'Determine last Row in Sheet("Work") Column A
  lastRw = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
''Loop to copy rows to specific sheets
    For srcRw = 3 To lastRw
'Determine destination sheet name
     dstSht = Sheets("Work").Range("A" & srcRw)
'Determine next empty row in destination sheet
     dstRw = Sheets(dstSht).Range("A" & Rows.Count).End(xlUp).Row + 1
'Copy Row
      Rows(srcRw).EntireRow.Copy _
       Destination:=Sheets(dstSht).Range("A" & dstRw)
    Next
End Sub

Posting Tip: Before posting Data or VBA Code, read this How-To.


Report •

#8
November 26, 2010 at 20:56:23
Hey ok i added a title to Row1 and 2...and now it is doing the same thing . run-time 9..i just added the code you just gave me

Report •

#9
November 26, 2010 at 21:08:33
You never said what fixed the problem the last time, so there's not much more I can offer other than what I said in Response #5.

The new code works fine for me, copying Rows 1 and 2 to all 5 sheets and then copying rows 3 through the end to the sheets named for the values in column A.

I also offered a troubleshooting tip for which you have not provided an answer.

Posting Tip: Before posting Data or VBA Code, read this How-To.


Report •

#10
November 27, 2010 at 21:37:29
Well for 1) the "work" i gave you i actually chaned....so I put "Expenses" that i replaced for work, it worked 100% for me.

Now i try to insert a title into Row 1 and Row 2..and it gives me the error code


Report •

#11
November 28, 2010 at 07:55:35
re: "Now i try to insert a title into Row 1 and Row 2..and it gives me the error code"

I don't know what that means. What do you mean by "insert"?

I assume we are talking about this section of code:

'Copy Column Headings to each sheet
  For myShts = 2 To 6
    Sheets("Expenses").Rows("1:2").EntireRow.Copy _
      Destination:=Sheets(myShts).Range("A1")
  Next

That code simply copies Rows 1 and 2 from the first sheet (which I assume is now named Expenses) to sheets 2 through 6. It doesn't matter what the names of sheets 2 through 6 are since that are not referred to by Name but by the order in which they are in the workbook.

From where I'm sitting, there are only 2 ways that that section of code would produce a "Subscript out of range" error:

1 - You don't have a sheet named Expenses
2 - You don't have at least 6 sheets in the workbook

Posting Tip: Before posting Data or VBA Code, read this How-To.


Report •

#12
November 28, 2010 at 19:05:48
this is what i have in there

Sub CopyRows()
Dim lastRw, srcRw, dstRw, myShts As Integer
Dim dstSht As String
'Copy Column Headings to each sheet
For myShts = 2 To 6
Sheets("Expenses").Rows("1:2").EntireRow.Copy _
Destination:=Sheets(myShts).Range("A1")
Next
'Determine last Row in Sheet("Expenses") Column A
lastRw = Sheets("Expenses").Range("A" & Rows.Count).End(xlUp).Row
''Loop to copy rows to specific sheets
For srcRw = 3 To lastRw
'Determine destination sheet name
dstSht = Sheets("Expenses").Range("A" & srcRw)
'Determine next empty row in destination sheet
dstRw = Sheets(dstSht).Range("A" & Rows.Count).End(xlUp).Row + 1
'Copy Row
Rows(srcRw).EntireRow.Copy _
Destination:=Sheets(dstSht).Range("A" & dstRw)
Next
End Sub


the code before you gave me before adding the headings work fine.


Report •

#13
November 28, 2010 at 21:22:25
First, it appears that you did not read the How To referenced in my signature line. If you had, and followed the instructions given there, your code would have looked like the code I posted, formatted for easier reading. Please try to do that in the future.

Second, I still don't know what you mean by "inserting the headings or "adding the headings."

The code has nothing to do with adding or inserting headings. It simply copies the first 2 rows (Rows 1 & 2) of the Expenses sheet and pastes them into the first 2 rows (Rows 1 & 2) of the 5 other sheets.

It then goes back to the Expenses sheet and looks at A3. It takes the value from A3, looks for a matching sheet name, and copies Row 3 from the Expenses sheet to the sheet with the matching name. It then looks at A4 and does the same thing, then A5, over and over, until it reaches the end of the data in Column A.

If you don't have sheet names that match the values in A3 through A?? (the end of the data), you'll get an error.

Fourth, back in Response #5 I offered a troubleshooting tip. Please go back and reread it. If you just keep telling me that the code doesn't work without following that tip and telling me where the code fails, I can not offer you any more assistance.

Posting Tip: Before posting Data or VBA Code, read this How-To.


Report •

Ask Question