ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Macro For Breaking Data To Different Sheets (https://www.excelbanter.com/excel-discussion-misc-queries/224981-macro-breaking-data-different-sheets.html)

FARAZ QURESHI

Macro For Breaking Data To Different Sheets
 
I have a sheet with consolidated data as follows:
Region Branch Case Amount Date

Can an expert friend devise me a code to sort the data branch wise and then
create different sheets for every branch?

Thanx in advance!

--
Best Regards,
FARAZ A. QURESHI

Sheeloo[_4_]

Macro For Breaking Data To Different Sheets
 
To enter the macro
Open your workbook
Rename the sheet with data as DATA
Press ALT-F11
Insert Module
Paste the Code
To run press F5
Warning: It will rewrite any sheets with names matching any branch (assumed
to be in Col B).
It will create a sheet for every branch name and copy data there...

Option Base 1
Sub distribute()
'Region Branch Case Amount Date
Dim j As Integer
j = 1
Dim lastRow As Long
Dim sourceSheet As Worksheet
Dim currentSheet As String
Dim sheetName As String
Dim currentRow() As Long

Set sourceSheet = Worksheets("Data")
With sourceSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

ReDim currentRow(Sheets.Count)
For i = 1 To Sheets.Count
currentRow(i) = 2
Next

For i = 2 To lastRow
flag = True
currentSheet = sourceSheet.Cells(i, 2)
j = 0
For Each ws In Worksheets
j = j + 1
If ws.Name = currentSheet Then
flag = False
Exit For
End If
Next ws
If flag Then
Worksheets.Add After:=Sheets(Sheets.Count)
j = Sheets.Count
Worksheets(j).Name = currentSheet
ReDim Preserve currentRow(j)
currentRow(j) = 2
End If
sourceSheet.Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(j).Cells(currentRow(j), 1)
currentRow(j) = currentRow(j) + 1
Next i
'MsgBox currentRow(15)
End Sub


"FARAZ QURESHI" wrote:

I have a sheet with consolidated data as follows:
Region Branch Case Amount Date

Can an expert friend devise me a code to sort the data branch wise and then
create different sheets for every branch?

Thanx in advance!

--
Best Regards,
FARAZ A. QURESHI


Ron de Bruin

Macro For Breaking Data To Different Sheets
 
See also
http://www.rondebruin.nl/copy5.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"FARAZ QURESHI" wrote in message ...
I have a sheet with consolidated data as follows:
Region Branch Case Amount Date

Can an expert friend devise me a code to sort the data branch wise and then
create different sheets for every branch?

Thanx in advance!

--
Best Regards,
FARAZ A. QURESHI

__________ Information from ESET Smart Security, version of virus signature database 3952 (20090320) __________

The message was checked by ESET Smart Security.

http://www.eset.com





__________ Information from ESET Smart Security, version of virus signature database 3952 (20090320) __________

The message was checked by ESET Smart Security.

http://www.eset.com




FARAZ QURESHI

Macro For Breaking Data To Different Sheets
 
XClent!!!!
However,
1. The headers are not being copied to the new sheet; &
2. The main Data sheet remains to be unsorted.

Any idea?

--

Best Regards,
FARAZ A. QURESHI


"Sheeloo" wrote:

To enter the macro
Open your workbook
Rename the sheet with data as DATA
Press ALT-F11
Insert Module
Paste the Code
To run press F5
Warning: It will rewrite any sheets with names matching any branch (assumed
to be in Col B).
It will create a sheet for every branch name and copy data there...

Option Base 1
Sub distribute()
'Region Branch Case Amount Date
Dim j As Integer
j = 1
Dim lastRow As Long
Dim sourceSheet As Worksheet
Dim currentSheet As String
Dim sheetName As String
Dim currentRow() As Long

Set sourceSheet = Worksheets("Data")
With sourceSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

ReDim currentRow(Sheets.Count)
For i = 1 To Sheets.Count
currentRow(i) = 2
Next

For i = 2 To lastRow
flag = True
currentSheet = sourceSheet.Cells(i, 2)
j = 0
For Each ws In Worksheets
j = j + 1
If ws.Name = currentSheet Then
flag = False
Exit For
End If
Next ws
If flag Then
Worksheets.Add After:=Sheets(Sheets.Count)
j = Sheets.Count
Worksheets(j).Name = currentSheet
ReDim Preserve currentRow(j)
currentRow(j) = 2
End If
sourceSheet.Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(j).Cells(currentRow(j), 1)
currentRow(j) = currentRow(j) + 1
Next i
'MsgBox currentRow(15)
End Sub


"FARAZ QURESHI" wrote:

I have a sheet with consolidated data as follows:
Region Branch Case Amount Date

Can an expert friend devise me a code to sort the data branch wise and then
create different sheets for every branch?

Thanx in advance!

--
Best Regards,
FARAZ A. QURESHI



All times are GMT +1. The time now is 11:06 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com