Copy and paste data into new tab, keep format and change tab names

[CRMTHB]

Hi,


I have headers in row 1, with data underneath. For every change in column A, I want the data (plus the headers) copied and pasted into a new tab. I then want that tab to be named the same as the data then in cell A2 of the new tabs.


So, if there are 7 rows with "Bananas", I want those 7 moved to a new tab called "Bananas". The next 3 which say "Apples" to be called Apples etc.


Each tab would have the headers, and would have the same formatting used in the original sheet.

If this is possible, any help would be appreciated

Thanks

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub CRMTHB()
   Dim Ws As Worksheet
   Dim Cl As Range
   Dim Ky As Variant
   
   Set Ws = Sheets("Pcode")
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Ky In .Keys
         Ws.Copy , Sheets(Sheets.Count)
         With ActiveSheet
            .Name = Ky
            .Range("A1").AutoFilter 1, "<>" & Ky
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
         End With
      Next Ky
   End With
End Sub

 

[CRMTHB]

Hi Fluff, thank you for coming back to me.

The code works really well except some of the names are more than 31 characters, meaning it's too long for the tabs. Is there code that would limit the name of the tabs to 30 characters?

Thanks
Matt

 

[Fluff]

Just use this

            .Name = Left(Ky, 30)

 

[CRMTHB]

That works great!

Thanks again

 

[Fluff]

You're welcome & thanks for the feedback