Split workbook into separate worksheets and copy only certain columns to new worksheets

[Imtiaz]

Hi....I found this code on the forum to split workbook into separate worksheets which works perfectly but I only want to copy across certain columns to the new worksheets. I want columns I, M and W to copy across the new tabs. Can someone please assist. This

Sub columntosheets()


Const sname As String = "Master" 'change to whatever starting sheet
Const s As String = "M" '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

 

[Imtiaz]

Works perfectly. Thanks so much for your help with this.

I need to do another bit to this now. But I will start a new thread if it requires a complete new code for this. Basically what I need to do is check if the value in column I in the master worksheet exists in column A of another workbook which has multiple worksheets and needs to look at one particular worksheet.

 

[Fluff]

Glad to help & thanks for the feedback.

You will need to start a new thread for you new request.
Cheers