Excel VBA to copy list to new worksheet

Question

I have a list in Excel containing details of people This contains City, Address and name

I need to grab the City column and create a worksheet for each city, then copy the data from sheet1 to that new worksheet.

So if for example I have a city named Dublin, I need the macro to create a new worksheet named dublin, go to the list, grab all the cities named dublin, copy and paste them in the dublin worksheet (as well as the other columns of course)

I am using the macro form this link: http://www.mrexcel.com/forum/excel-questions/727407-visual-basic-applications-split-data-into-multiple-worksheets-based-column.html created by mirabeau.

The code is as follows:

Sub columntosheets() 

Const sname As String = "Sheet1" 'change to whatever starting sheet
Const s As String = "A" 'change to whatever criterion column
Dim d As Object, a, cc&
Dim p&, i&, rws&, cls&
Set d = CreateObject("scripting.dictionary")
With Sheets(sname)
    rws = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    cls = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    cc = .Columns(s).Column
End With
For Each sh In Worksheets
    d(sh.Name) = 1
Next sh

Application.ScreenUpdating = False
With Sheets.Add(after:=Sheets(sname))
    Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)
    .Cells(1).Resize(rws, cls).Sort .Cells(cc), 2, Header:=xlYes
    a = .Cells(cc).Resize(rws + 1, 1)
    p = 2
    For i = 2 To rws + 1
        If a(i, 1) <> a(p, 1) Then
            If d(a(p, 1)) <> 1 Then
                Sheets.Add.Name = a(p, 1)
                .Cells(1).Resize(, cls).Copy Cells(1)
                .Cells(p, 1).Resize(i - p, cls).Copy Cells(2, 1)
            End If
            p = i
        End If
    Next i
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End With
Sheets(sname).Activate

End Sub

The above is able to create worksheets for each city, but doesn't copy the data into the newly created worksheets. How can this be done? I have very limited knowledge of VBA and am totally lost on this.

Have you tried duplicating the worksheet, sorting by city, and then deleting what you don't need in order? That way you don't have to worry about copying anything. — Lumigraphics

David G David G · Accepted Answer · 2015-07-01T20:24:41

Once all the sheets are created, you just need to scour the list in search for cities. For each line, look at the city, and write it in the corresponding sheet. The sheets need to have the same names as the cities for my code to work.

I assume you started in column A, row 1.

dim strCity as string
dim strAdd as string
dim strName as string
for i = 1 to Sheets("[TableSheet]").Cells(Rows.Count, "A").End(xlUp).row
     strCity = Sheets("[TableSheet]").range("A" & i)
     strAdd = Sheets("[TableSheet]").range("B" & i)
     strName = Sheets("[TableSheet]").range("C" & i)

     Sheets(strCity).Range("A" & i) = strCity
     Sheets(strCity).Range("B" & i) = strAdd
     Sheets(strCity).Range("C" & i) = strName
next

[tableSheet] of course is the name of the sheet with your information.If you don't udnerstand and have questions I can gladly answer.

Excel VBA to copy list to new worksheet

2 Answers