Copy rows, paste to new worksheet, rename new worksheet, return to Source material

[fuzzyizzabear]

Restarting my VBA education after several years away, and am stumped on what I imagine is a very very common situation. If anyone can point me to a Post already explaining how to do this, I will be very thankful.

Also, I want to code as good as you guy folks do. Are there particularly good courses, video series, or books for me to invest in?

SITUATION: A database is dumped into Excel, a single worksheet with many columns/fields and several thousand rows in the source. I have scrubbed the Source data--eliminated bad data such as misspellings, multiple names in a single field. I'm confident I have good Source data now.

• Row 1 has the field names: Name, Address, etc.
• Column A has the search criteria values: Blue, Green, Red, etc.

Goals:

1. Search all rows in Source worksheet where values in Column A are equal: all Blue.
2. Copy those entire rows, and paste the copied rows onto a new worksheet, so all Blues on the first worksheet, all Reds on the next, etc.
3. Also copy the header row from Source, and insert it to Row 1 of each new worksheet.
4. Rename the worksheets with the values from Column A: "Sheet2" changes to "Blue" etc.
5. Repeat all the way through the file.

That's it.

It'll be a gigantic workbook with hundreds of sheets, likely to be unwieldy to work with but that's what my buddy asked for.

Thanks very much for the consideration!

 

[vcoolio]

Hello Fuzzyizzabear,

This could at least set you in the right direction:-

Sub CreateNewShtsTransferData()
   
        Dim sht As Worksheet
        Dim lr As Long, i As Long
        Dim ID As Object
        Dim key As Variant

        Set sht = Sheet1 '---->Sheet1 is your main sheet. Here I've used the sheet code not the sheet name.
        Set ID = CreateObject("Scripting.Dictionary")
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
    
        lr = sht.Range("A" & Rows.Count).End(xlUp).Row
    
For i = 2 To lr
        If Not ID.Exists(sht.Range("A" & i).Value) Then
        ID.Add sht.Range("A" & i).Value, 1
        End If
Next i

For Each key In ID.keys
        If Not Evaluate("ISREF('" & key & "'!A1)") Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = key
        End If
   
        sht.Range("A1:A" & lr).AutoFilter 1, key
        sht.[A1].CurrentRegion.Copy Sheets(key).[A1]
        Sheets(key).Columns.AutoFit
        sht.[A1].AutoFilter
Next key

sht.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "All done!", vbExclamation

End Sub

Test it in a copy of your workbook first.

I hope that this helps.

Cheerio,
vcoolio.