Split one excel sheet into multiple sheets based on column value

nr6281

New Member
Joined
Jun 19, 2019
Messages
37
Hi,

I found an macro online that works perfect in splitting the data into multiple sheets based on Column "S". However I only need selected columns to go to the other sheets vs the current all data in Raw file.

I only want the following column to be split "A:B" "E" "H" "J" "N:O" "R:T" only these columns should move.

Code:
[/COLOR][COLOR=#333333].Cells(Rows.Count, c).End(xlUp).Row[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">
ws.Cells(1, c).Resize(r1).Sort Key1:=ws.Cells(1, c), Header:=xlYes

ws.AutoFilterMode = False

Application.DisplayAlerts = False

For x = 2 To r1

For Each ws1 In Sheets

If ws1.Name = ws.Cells(x, c) Then ws1.Delete

Next

Next

Application.DisplayAlerts = True

For x = 2 To r1

ws.Range(ws.Cells(1, sCol), ws.Cells(r, sCol)).AutoFilter Field:=1, Criteria1:=ws.Cells(x, c)

Set ws1 = Worksheets.Add(after:=Worksheets(Worksheets.Count))

ws1.Name = ws.Cells(x, c).Value

rng.SpecialCells(xlCellTypeVisible).Copy

Range("A1").PasteSpecial Paste:=xlPasteFormats

Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

Range("A1").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

Next x

With ws

.AutoFilterMode = False

.Cells(1, c).Resize(r).ClearContents

.Activate

.Range("A1").Select

End With

Application.ScreenUpdating = True
 </code>[COLOR=#333333]End Sub[/COLOR][COLOR=#333333]
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hi
Do you mean the copied "A:B" "E" "H" "J" "N:O" "R:T
go to DESTINATION A,B,C,D,E.....
Regards
 
Upvote 0
Cross posted https://www.excelforum.com/excel-pr...ue-but-only-selected-columns.html#post5199773

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
 
Upvote 0
Hi
Would you please Try this
Code:
Sub Test()
    Dim a,i,j,s
        a = Sheets("sheet1").Range("A3", Range("T" & Rows.Count).End(xlUp)).Value
        a = Application.Index(a, _
                          Application.Evaluate("row(1:" & UBound(a) - LBound(a) + 1 & ")"), _
                          Array(1, 2, 5, 8, 10, 14, 15, 18, 19, 20))   ' only cols F,G,P,Q,W,X,Y
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 0
        For i = 1 To UBound(a)
            If Not .exists(a(i, 9)) Then
                .Add a(i, 9), Join(Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7), a(i, 8), a(i, 9), a(i, 10)), Chr(164))
            Else
                .Item(a(i, 9)) = .Item(a(i, 9)) & Chr(166) & Join(Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7), a(i, 8), a(i, 9), a(i, 10)), Chr(164))
            End If
            k = .keys
            itm = .items
        Next
        For i = 0 To .Count - 1
            With Sheets(k(i))
                .Select
                s = Split(itm(i), Chr(166))
                .Cells(1, 1).Resize(UBound(s) + 1) = Application.Transpose(s)
                For l = 1 To UBound(s) + 1
                    Cells(l, 1).TextToColumns Destination:=Cells(l, 1), DataType:=xlDelimited, _
                                              OtherChar:=Chr(164), FieldInfo:=Array(l, 1)
                Next
            End With
        Next
    End With
End Sub

Your data in sheet1 A3 ...j
And sheets names are in column S in your post#1
Tel me If you need any thing
Regards
 
Last edited:
Upvote 0
Hi
Are the Sheets A,B,C... exist
OR YOU WANT TO ADD THEM
i CAN NOT SEE ANY ATTACHMENT
 
Last edited:
Upvote 0
hi,

Mohadin someone in another forum had helped me solve this of splitting data, I really appreciate your help in this.

https://www.excelforum.com/excel-pr...nd-auto-assign-names-to-task.html#post5202870

The above is the link to what I am trying to achieve and seems, SO far i;ve got the splitting data by your help and another at the forum.

But I am trying to record or see if there is a way to auto assign names to the task above is the forum along with the template
 
Upvote 0

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top