Copy Data to multiple sheets

Microsoft Office excel 2007 home & stude...
September 10, 2010 at 17:15:34
Specs: Windows 7
Hey guys,
I need some help. All of my data is in Sheet one listed as:
Column A - Date
Column B - Name
Column C - Amount Received
Column D - Amount Paid
Column E - Balance Owed
All of the headers of those columns would be the same on each worksheet. What I need help with is that I need to create new worksheets for each Name Sheet 1 data.

Looking around came across the codes by Humar as MovetoTab. worked exactly as I would have wanted. But would like all cells to be autofit to the cell content once all the new worksheets have been created. Thanks in advance. The code by Humar

Public Sub MoveToTab()
Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range

On Error GoTo ErrHnd

With Worksheets("Source")
'set start as B2 i.e., after heading row in column B
Set rngStart = .Range("B2")
'set end - last used row in column B
Set rngEnd = .Range("B" & CStr(Application.Rows.Count)).End(xlUp)

'setup destination worksheets
'either create new if they don't exist,
'or clear existing data if they do
'loop through cells in column B
For Each rngCell In Range(rngStart, rngEnd)
'test if tab exists
On Error Resume Next
If Not Worksheets(rngCell.Text).Name <> "" Then
On Error GoTo ErrHnd
'No worksheet of this name - so create one
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = rngCell.Text

On Error GoTo ErrHnd
'clear data
End If
Next rngCell

'loop through cells in column B
For Each rngCell In Range(rngStart, rngEnd)
'worksheets will all exist
'copy row to end of used range
Sheets(1).Cells(1).EntireRow.Copy _
rngCell.EntireRow.Copy _
Destination:=Worksheets(rngCell.Text) _
.Range("B" & CStr(Application.Rows.Count)).End(xlUp) _
.Offset(1, -1)
Next rngCell
End With
Exit Sub

'error handler
End Sub

See More: Copy Data to multiple sheets

September 11, 2010 at 05:34:21

Between the lines: End With and Exit Sub, add this code (you can put the Dim line up with the other Dim's at the start of the macro):

'set the width of columns in all worksheets (except "Source")
'using columns A to E
Dim wsEach As Worksheet
'loop through all worksheets
For Each wsEach In ActiveWorkbook.Worksheets()
    If wsEach.Name <> "Source" Then
        'not "Source" worksheet, so auto-fit columns A to E
    End If
Next wsEach

If there are other worksheets in the workbook that you do not want to 'auto-fit' then use something like this:

If wsEach.Name <> "Source" And wsEach.Name <> "Sheet2" Then


Report •

September 12, 2010 at 14:27:28
Thnx Humar. That was great. Just one last request. I need to have a running balance in column E i.e. Balance Owed, calculated as "D"-"C". Is there any way by which these formulas are inserted in the column E when the multiple sheets are created. Presently am doing this manually and inserting formula in 100's of sheets is really tiresome.

thnx once again for your help.

Report •

September 12, 2010 at 17:57:29

The code you posted appears to copy whole rows from source to destination worksheet. If the source worksheet contains the formula "=Dx-Cx" in column E, then this will be copied to the destination worksheets. As long as the row numbers are not using $ signs, the formulas will work when copied.

If you have =D20-C20 (in source worksheet, row 20) and this is copied to a destination sheet on say row 3, it will become =D3-C3.

Do you have the =Dx-Cx formulas in the source worksheet.

Let me know.


Report •
Related Solutions

Ask Question