Split Data to Several Sheet from large sheet

ASK

New Member
Joined
Nov 10, 2021
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
I am struggling to copy and paste data from large sheet and need help if anyone can help me to write VBA.

I want to split data from main sheet named “ALL DATA” to multiple sheets.

Headers are from A1 to M1 in Row A1

Name of sheets are entered in Column (“A2:A”)

I want to copy data from column (A2: D2) & rows can be many of “ALL DATA” sheet

I want to create sheets automatically by names given in Column (“A2:A”) if not already created and copy data in each sheet when I run Macro.
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Hello Ask,

Here's one method that you could try:-

VBA Code:
Option Explicit

Sub Test()

              Dim i As Long, lr As Long
              Dim sh As Worksheet, wsD As Worksheet, ar As Variant
        
Application.ScreenUpdating = False
        
              Set sh = Sheets("ALL DATA")
              lr = sh.Range("A" & Rows.Count).End(xlUp).Row
              sh.Range("A1:A" & lr).AdvancedFilter 2, , sh.[Z1], 1  'Unique values moved temporarily to Column Z.
              sh.Range("Z2", sh.Range("Z" & sh.Rows.Count).End(xlUp)).Sort [Z2], 1 'Unique values sorted.
              ar = sh.Range("Z2", sh.Range("Z" & sh.Rows.Count).End(xlUp))
              
       For i = 1 To UBound(ar)
              If Not Evaluate("ISREF('" & CStr(ar(i, 1)) & "'!A1)") Then
                    Sheets.Add(After:=Sheets(Worksheets.Count)).Name = ar(i, 1)
              End If
                    
              Set wsD = Sheets(CStr(ar(i, 1)))
              wsD.UsedRange.Clear
                    
              With sh.[A1].CurrentRegion
                   .AutoFilter 1, ar(i, 1)
                   .Resize(, 4).Copy wsD.[A1]
                   .AutoFilter
             End With
                   wsD.Columns.AutoFit
                   sh.Columns("Z").Clear
       Next i

Application.Goto sh.[A1]
Application.ScreenUpdating = True

End Sub

I'm assuming that you only have the "ALL DATA" sheet in your workbook currently.
The above code will create new worksheets for each unique name in Column A and then transfer the relevant rows of data (from Columns A:D only) to their respective sheets.
Please test the code in a copy of your actual workbook first.

I hope that this helps.
Cheerio,
vcoolio.
 
Upvote 0
Solution
Hello Ask,

Here's one method that you could try:-

VBA Code:
Option Explicit

Sub Test()

              Dim i As Long, lr As Long
              Dim sh As Worksheet, wsD As Worksheet, ar As Variant
       
Application.ScreenUpdating = False
       
              Set sh = Sheets("ALL DATA")
              lr = sh.Range("A" & Rows.Count).End(xlUp).Row
              sh.Range("A1:A" & lr).AdvancedFilter 2, , sh.[Z1], 1  'Unique values moved temporarily to Column Z.
              sh.Range("Z2", sh.Range("Z" & sh.Rows.Count).End(xlUp)).Sort [Z2], 1 'Unique values sorted.
              ar = sh.Range("Z2", sh.Range("Z" & sh.Rows.Count).End(xlUp))
             
       For i = 1 To UBound(ar)
              If Not Evaluate("ISREF('" & CStr(ar(i, 1)) & "'!A1)") Then
                    Sheets.Add(After:=Sheets(Worksheets.Count)).Name = ar(i, 1)
              End If
                   
              Set wsD = Sheets(CStr(ar(i, 1)))
              wsD.UsedRange.Clear
                   
              With sh.[A1].CurrentRegion
                   .AutoFilter 1, ar(i, 1)
                   .Resize(, 4).Copy wsD.[A1]
                   .AutoFilter
             End With
                   wsD.Columns.AutoFit
                   sh.Columns("Z").Clear
       Next i

Application.Goto sh.[A1]
Application.ScreenUpdating = True

End Sub

I'm assuming that you only have the "ALL DATA" sheet in your workbook currently.
The above code will create new worksheets for each unique name in Column A and then transfer the relevant rows of data (from Columns A:D only) to their respective sheets.
Please test the code in a copy of your actual workbook first.

I hope that this helps.
Cheerio,
vcoolio.
Thank you dear. It works perfectly. I really appreciate you.
 
Upvote 0
You're welcome Ask. I'm glad to have been able to assist and thanks for the feed back.

Cheerio,
vcoolio.
 
Upvote 0

Forum statistics

Threads
1,213,491
Messages
6,113,963
Members
448,536
Latest member
CantExcel123

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