Using excel macro,How to break down the data in a particular column to another sheet

[dolphino]

hai all forum member,
Please help me about this case, I want to break down the data in a particular column in a table and move the results of each of the data in the last column to the other sheets (separated sheet). For example, there is a table with his column title header cities and population. on a column of data contained city of Jakarta, Bali and Bandung with each 1000,1500,2000 population. I want to break down each column of the city and the number of people to another sheet and rename the sheet breakdown products in accordance with the specified column. Solving the column based on the column of the city, so the end result on the second sheet (sheet name into Jakarta and the contents of the column sheet cities (Jakarta) and population (1000), the third sheet (sheet name into the sheet and fill bali city column (bali) and population (1500), on sheet 4 (sheet name into the sheet duo and fill the city column (Bandung) and population (2000), please enlightenment friends. If done manually copy and paste it will take a long time . Please help how to code macros to execute it. Thanks for the enlightenment.

[natefarm]

Please attach a sample workbook with the current data and desired outcome.

[dolphino]

hi natefarm
i want ti insert attchmnt for smple workbook, but i'cant. how can do it to insert my sample workbook to this thread? would you show me how? thank your for your attantion ...

[dolphino]

hi natefarm

this sample workbook, please kindly help. thank you

[natefarm]

Sorry, I'm unable to open the attachment. Maybe someone else can? If not, please try again.

[dolphino]

hi all, please kindly help about my question above,,, thank you

[Alf]

Perhaps like this?

To test run macro "ExtrData"

Alf

[dolphino]

Hi Alf
I've tried the code of your macros, and the code working very well. if the table contains thousands of rows, whether macro code is in keeping with what we want? What things should I edit the macros Alf? thank you for the information.

[Alf]

if the table contains thousands of rows, whether macro code is in keeping with what we want?

Well as long as the indata is on Sheet1 and city name in column A and population figure in column B and C the this macro will work.

But when you are speaking of thousands of rows this macro is not especially fast. Then a macro based on autofilter technic would probably be better and the added worksheet should be sorted in alphbetical order as well?

How many differen cities are we talking about? A file with several hundred worksheets is not to recomend. One option could be that instead of adding worksheets for each city one could save the worksheet as a separate file with city name as file name.

At the moment I would suggest a small change of my original macro. To copy the headings from Sheet1 and pasting it to the new sheets insted of writing them as the macro does at the moment.

Option Explicit

Sub ExtrData()
Dim cell As Range

Application.ScreenUpdating = False
Sheets("Sheet1").Activate

For Each cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)

Range(cell, cell.Offset(0, 2)).Copy

On Error Resume Next
Sheets(cell.Value).Activate
If Err.Number = 9 Then
    Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = cell.Value
        Range("A2").PasteSpecial xlPasteAll
        Sheets("Sheet1").Range("A1:C1").Copy
        Range("A1").PasteSpecial xlPasteAll
        Columns("A:C").Columns.AutoFit
        Application.CutCopyMode = False
    Else
        Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
        Columns("A:C").Columns.AutoFit
        Application.CutCopyMode = False
End If

Sheets("Sheet1").Activate

Next

Application.ScreenUpdating = True

End Sub

Alf

[dolphino]

51 City in my file table, the column has been my city sort by alphabet. If I've been splitting the file into sheet 51 respectively, the breakdown products of the sheet would I export per each file based on the name of the city. I've tried resetting earlier with additional macros from you as above. All working very well Alf, please see attached sample in the workbook. Thank you for your attention

[Alf]

Yes it does and reasonably fast also. Good idea of you to sort the cites before running the macro. It's so much easier to find a specific city among 51 others when sheets are added in alphabetical order.

So as far as I see you just need one macro so you either choose "Test1" or "Test2" both work equally well but "Test2" has the nicer headings in my opinion.

As this solves your problem don't forget to mark your thread "Solved"

Alf

Ps

To mark your thread solved do the following:
-Go to the top of the first post
-Select Thread Tools
-Select Mark thread as Solved

[dolphino]

Hi Alf

Morning Alf, yes so am i, i choose the macro "test2" too. thank you for all your help.

this thread already solved....

[Alf]

You are welcome.

Thanks for feedback

[abitbudiharjo]

Morning Alf,

Many thanks for your code before.

I want to ask, how if i only want to select some cities?

or maybe I can use the Data Validation?

Thanks

[Alf]

Hi and welcome to the forum

Forum rule #2 says:

Don't post a question in the thread of another member -- start your own. If you feel it's particularly relevant, provide a link to the other thread. You may include up to 3 links to other URLs in a single post, no more, so only link to the relevant pages.

but since this is your first posting I'll not make an issue of it this time but in the future don't ignore forum rules.

Back to you question. I think the simplest way of solving this would be that add the word Yes to column D for the cities you wish to select and the modified macro would look like this.

Sub ChooseCity()
Dim cell As Range

Application.ScreenUpdating = False
Sheets("Sheet1").Activate

For Each cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)

If cell.Offset(0, 3) = "Yes" Then

Range(cell, cell.Offset(0, 2)).Copy

On Error Resume Next
Sheets(cell.Value).Activate
If Err.Number = 9 Then
    Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = cell.Value
        Range("A2").PasteSpecial xlPasteAll
        Sheets("Sheet1").Range("A1:C1").Copy
        Range("A1").PasteSpecial xlPasteAll
        Columns("A:C").Columns.AutoFit
        Application.CutCopyMode = False
    Else
        Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
        Columns("A:C").Columns.AutoFit
        Application.CutCopyMode = False
End If

End If

Next

Sheets("Sheet1").Activate

Application.ScreenUpdating = True

End Sub

Alf