Excel VBA to copy list to new worksheet - vba

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.

Answer 1

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.

Answer 2

thanks for your swift reply. I used it on a simple list and it worked fine. However, I applied it to a slightly more complex scenario and edited the code as follows:
Dim strDB As String
Dim strName As String
Dim strDate As String
Dim strHour As String
Dim strMin As String
Dim strGR As String
For i = 1 To Sheets("[TableSheet]").Cells(Rows.Count, "B").End(xlUp).Row
strDB = Sheets("[TableSheet]").Range("A" & i)
strName = Sheets("[TableSheet]").Range("B" & i)
strDate = Sheets("[TableSheet]").Range("C" & i)
strHour = Sheets("[TableSheet]").Range("D" & i)
strMin = Sheets("[TableSheet]").Range("E" & i)
strGR = Sheets("[TableSheet]").Range("F" & i)
Sheets(strName).Range("A" & i) = strDB
Sheets(strName).Range("B" & i) = strName
Sheets(strName).Range("C" & i) = strDate
Sheets(strName).Range("D" & i) = strHour
Sheets(strName).Range("E" & i) = strMin
Sheets(strName).Range("F" & i) = strGR
Next
I need to sort by column B. Whenever I run it I keep getting a runtime error '9' Subscript out of range. I know what this means but I can't find where I went wrong in the code.