Split Data based on Value in Row

[MR_786]

Hi,

This is my post on this forum, I have data in the following format:

1. I want to split the data from the master worksheet into multiple worksheets based on the value in row 6 (move entire columns to new worksheet).
2. I also want the first column to be recurring on every worksheet.
3. I would like for each new worksheet created to use the value in row 6 that it was split by as the worksheet name.

Any help will be much appreciated!

 

[DanteAmor]

Hi and welcome to MrExcel.

Try the following macro, fit your master sheet name on this line:
Set sh1 = Sheets("Master") 'Fit to your sheet name

Sub SplitData()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim lr As Long, lc As Long
  Dim c As Range
  Dim ky As Variant
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  Set sh1 = Sheets("Master")  'Fit to your sheet name
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  lc = sh1.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
  Set sh2 = Sheets.Add
  sh1.Range("A1", sh1.Cells(lr, lc)).Copy
  sh2.Range("A1").PasteSpecial xlPasteValues, , , True
 
  With CreateObject("scripting.dictionary")
    For Each c In sh2.Range("F2", sh2.Range("F" & Rows.Count).End(xlUp))
      If c.Value <> "" Then .Item(c.Value) = Empty
    Next c
    For Each ky In .Keys
      sh2.Range("A1", sh2.Cells(lc, lr)).AutoFilter 6, ky
      Sheets.Add(, Sheets(Sheets.Count)).Name = ky
      sh2.AutoFilter.Range.Copy
      Range("A1").PasteSpecial xlPasteValues, , , True
    Next ky
  End With
  sh1.Select
  sh2.Delete
End Sub

 

[MR_786]

Hi and welcome to MrExcel.

Try the following macro, fit your master sheet name on this line:
Set sh1 = Sheets("Master") 'Fit to your sheet name

Sub SplitData()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim lr As Long, lc As Long
  Dim c As Range
  Dim ky As Variant
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  Set sh1 = Sheets("Master")  'Fit to your sheet name
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  lc = sh1.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
  Set sh2 = Sheets.Add
  sh1.Range("A1", sh1.Cells(lr, lc)).Copy
  sh2.Range("A1").PasteSpecial xlPasteValues, , , True
 
  With CreateObject("scripting.dictionary")
    For Each c In sh2.Range("F2", sh2.Range("F" & Rows.Count).End(xlUp))
      If c.Value <> "" Then .Item(c.Value) = Empty
    Next c
    For Each ky In .Keys
      sh2.Range("A1", sh2.Cells(lc, lr)).AutoFilter 6, ky
      Sheets.Add(, Sheets(Sheets.Count)).Name = ky
      sh2.AutoFilter.Range.Copy
      Range("A1").PasteSpecial xlPasteValues, , , True
    Next ky
  End With
  sh1.Select
  sh2.Delete
End Sub

Hi, many thanks for your response, the code works perfectly!
If it isn't too much to ask can you please annotate each line of your code with some descriptive text so I can enhance my knowledge.

 

[DanteAmor]

If it isn't too much to ask can you please annotate each line of your code with some descriptive text so I can enhance my knowledge

Sub SplitData()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim lr As Long, lc As Long
  Dim c As Range
  Dim ky As Variant
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  'Set the sheet to the sh1 variable
  Set sh1 = Sheets("Master")  'Fit to your sheet name
  'last row of column A
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  'last column of the sheet
  lc = sh1.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
  
  'Set the new sheet to the sh2 variable
  Set sh2 = Sheets.Add
  
  'Copy the data from sheet1 to the new TEMPORAL sheet
  sh1.Range("A1", sh1.Cells(lr, lc)).Copy
  sh2.Range("A1").PasteSpecial xlPasteValues, , , True
 
 'Create a dictionary, it's like an index of unique data
  With CreateObject("scripting.dictionary")
  
    'Stores in the dictionary the unique data of column F
    For Each c In sh2.Range("F2", sh2.Range("F" & Rows.Count).End(xlUp))
      If c.Value <> "" Then .Item(c.Value) = Empty
    Next c
    
    'For each key stored in the dictionary
    For Each ky In .Keys
      'Filter the data in column 6 (F)
      sh2.Range("A1", sh2.Cells(lc, lr)).AutoFilter 6, ky
      'Create the new sheet and name it the data of the key
      Sheets.Add(, Sheets(Sheets.Count)).Name = ky
      'Copy the data and paste it on the new sheet
      sh2.AutoFilter.Range.Copy
      Range("A1").PasteSpecial xlPasteValues, , , True
    Next ky
  End With
  sh1.Select
  'delete TEMPORAL sheet
  sh2.Delete
End Sub

 

[MR_786]

Sub SplitData()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim lr As Long, lc As Long
  Dim c As Range
  Dim ky As Variant
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  'Set the sheet to the sh1 variable
  Set sh1 = Sheets("Master")  'Fit to your sheet name
  'last row of column A
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  'last column of the sheet
  lc = sh1.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
 
  'Set the new sheet to the sh2 variable
  Set sh2 = Sheets.Add
 
  'Copy the data from sheet1 to the new TEMPORAL sheet
  sh1.Range("A1", sh1.Cells(lr, lc)).Copy
  sh2.Range("A1").PasteSpecial xlPasteValues, , , True
 
 'Create a dictionary, it's like an index of unique data
  With CreateObject("scripting.dictionary")
 
    'Stores in the dictionary the unique data of column F
    For Each c In sh2.Range("F2", sh2.Range("F" & Rows.Count).End(xlUp))
      If c.Value <> "" Then .Item(c.Value) = Empty
    Next c
   
    'For each key stored in the dictionary
    For Each ky In .Keys
      'Filter the data in column 6 (F)
      sh2.Range("A1", sh2.Cells(lc, lr)).AutoFilter 6, ky
      'Create the new sheet and name it the data of the key
      Sheets.Add(, Sheets(Sheets.Count)).Name = ky
      'Copy the data and paste it on the new sheet
      sh2.AutoFilter.Range.Copy
      Range("A1").PasteSpecial xlPasteValues, , , True
    Next ky
  End With
  sh1.Select
  'delete TEMPORAL sheet
  sh2.Delete
End Sub

Thank you! I really appreciate it.

 

[DanteAmor]

Im glad to help you, thanks for the feedback