Macro help! Move a row of data to separate sheet based off the value in column M and delete from original sheet

[kaneL2019]

New to VBA. Thanks ahead of time for any help.

I have a workbook with one sheet. Data from columns A to X. What I'm looking for is a macro that will move a row of data to separate sheet based off the value in column M and delete from original sheet.

Example: If "Person" in M:M, create sheet named "Person" and cut and paste row into that sheet. If "Company" in M:M, create sheet named "Company" and cut and paste row into that sheet. If "Fin Company" in M:M, create sheet named "Fin company" and cut and paste row into that sheet. If none of those things leave row(s) on Sheet1. Thanks again.

 

[DanteAmor]

Hi @kaneL2019
Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.

Set the following in the macro.

1. Put in this line of the macro the name of your sheet that contains the information.

Set sh = Sheets("Data")​

2. If you want to copy the header to the new sheets, then change this line:

sh.AutoFilter.Range.Offset(1).Copy Range("A1")​

By this line:

sh.AutoFilter.Range.Copy Range("A1")​

---------------​

Macro:

Sub CopyDataToSheets()
  Dim sh As Worksheet
  Dim ary As Variant
  Dim lr As Long
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  Set sh = Sheets("Data")
  For Each ary In Array("Person", "Company", "Fin Company")
    sh.Range("A:M").AutoFilter 13, ary
    lr = sh.Range("F" & Rows.Count).End(3).Row
    If lr > 1 Then
      On Error Resume Next: Sheets(ary).Delete: On Error GoTo 0
      Sheets.Add(, Sheets(Sheets.Count)).Name = ary
      sh.AutoFilter.Range.Offset(1).Copy Range("A1")
      sh.AutoFilter.Range.Offset(1).Delete
    End If
  Next
  sh.Select
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​