Copy rows and column to new worksheet with VBA - excel

Question

I really need help. In my data base on excel and the first column is made up by the codes of my clients. Every client can have different number of rows and so on. What I’m trying to do is create a VBA Macro that can go through my list of client codes and for each code copy it’s rows on the DB to a new worksheet. And to do this for all the client codes I have like on loop, after copying the first one to go automatically to the next code.
Please help :(

Answer 1

I hope this provides a framework for you to do what you want.
Key concepts
Use autofilter to identify all records for each client
store client id in a dictionary to keep track of what has been processed
use SpecialCells to reference filtered rows
My simple input data
My output
Let me know if its helpful
Option Explicit
Sub master_db_to_individual()
Dim ws_in As Worksheet
Set ws_in = ThisWorkbook.Worksheets("master_db")
' Not knowing the actual shape of the data, this is just a simple way to set the required range locations
Dim r_keys As Range
Set r_keys = Range(ws_in.Range("a2"), ws_in.Range("a2").End(xlDown))
Dim r_all_data_with_headers As Range
Set r_all_data_with_headers = ws_in.Range("a2").CurrentRegion
'create a dictionary to store client codes found
Dim client_codes As Object
Set client_codes = CreateObject("Scripting.Dictionary")
' create a new workbook for individual data
Dim wb_individual As Workbook
Set wb_individual = Application.Workbooks.Add
Dim initial_ws_count As Long
initial_ws_count = wb_individual.Worksheets.Count
' loop all entires in the client code column of the master data
Dim client_code As Range
For Each client_code In r_keys
'test if have already processed the current row
' I am assuming here that the order of the client records can not be guaranteed
If Not client_codes.Exists(client_code.Value) Then
' make a record that this client has been processed so if we find another row for this client we know to skip
client_codes.Add client_code.Value, client_code.Value
'ensure a sheet for this client exists by inserting and supressing error if already exists
Dim ws_this_client As Worksheet
Set ws_this_client = wb_individual.Worksheets.Add(after:=wb_individual.Worksheets(wb_individual.Worksheets.Count))
ws_this_client.Name = client_code.Value
'filter all rows that have this client key so they can be copied
r_all_data_with_headers.AutoFilter field:=r_keys.Column, Criteria1:=client_code.Value, Operator:=xlFilterValues
'copy filtered data with headers to new sheet
r_all_data_with_headers.SpecialCells(xlCellTypeVisible).Copy ws_this_client.Range("a1")
End If
Next client_code
' remove autofilter
r_all_data_with_headers.AutoFilter
' remove unsed sheets in new workbook
Dim i As Integer
Application.DisplayAlerts = False
For i = initial_ws_count To 1 Step -1
wb_individual.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True
ws_in.Activate
ws_in.Range("a1").Select
Set client_codes = Nothing
End Sub