CODEWITHSUNDEEP
vbaexcel
Matthew Cremona
Matthew Cremona

Reputation: 17

Excel VBA to copy list to new worksheet

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.

Upvotes: 0

Views: 1684

Answers (2)

Matthew Cremona
Matthew Cremona

Reputation: 17

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.

Upvotes: 0

David G
David G

Reputation: 2347

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.

Upvotes: 0

Related Questions