Macro To Copy & Paste To Sheets

[crashing1912]

Hi all,

I have a master sheet of billing information with 1,000 lines of data for 30 different clients and I have 30 sheets with the names of each client as the sheet name. I need a macro, which will copy and paste each client's information from the master sheet into the client's worksheet five lines below the last entry. In addition, I need the macro to add a new sheet if the client name is not one of the client sheets. Below, I put what code I have, but over the past week of trying to figure this out, I can't really say how useful it is any more. I greatly appreciate any help on this. Let me know if you need anymore information. Thanks!

Sub Copyandpaste ()

Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow2 As Long
Dim LastRowCrit As Long
Dim I As Long
Dim FindLastRow As Long
Dim sh As Worksheet

Set wsAll = Worksheets("All") ' change All to the name of the worksheet the existing data is on

LastRow2 = wsAll.Range("A" & Rows.count).End(xlUp).Row
FindLastRow = Range("A65536").End(xlUp).Row

Set wsCrit = Worksheets.Add

' column A has the criteria
wsAll.Range("B1:B" & LastRow2).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
LastRowCrit = wsCrit.Range("A" & Rows.count).End(xlUp).Row



For Each sh In ActiveWorkbook.Worksheets
If wsCrit.Range("A2") <> sh.Name Then
wsAll.Rows("1:" & LastRow2).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=ws.Range("A1"), Unique:=False
wsCrit.Rows(2).Delete

Next sh

Else
For I = 2 To LastRowCrit
Set wsNew = Worksheets.Add
wsNew.Name = wsCrit.Range("A2")
wsAll.Rows("1:" & LastRow2).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False
wsCrit.Rows(2).Delete

Next I

Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True

End If

End Sub

 

[AlphaFrog]

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Copyandpaste()<br><br>    <SPAN style="color:#00007F">Dim</SPAN> wsAll       <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> wsClient    <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> LastRow     <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> rngClients  <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> Client      <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br><br>    <SPAN style="color:#00007F">Set</SPAN> wsAll = Worksheets("All")    <SPAN style="color:#007F00">' change All to the name of the worksheet the existing data is on</SPAN><br>    LastRow = wsAll.Range("B" & Rows.Count).End(xlUp).Row<br>    <br>    wsAll.Range("B1:B" & LastRow).AdvancedFilter Action:=xlFilterInPlace, Unique:=<SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rngClients = wsAll.Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible)<br>    <SPAN style="color:#00007F">If</SPAN> wsAll.FilterMode <SPAN style="color:#00007F">Then</SPAN> wsAll.ShowAllData<br>    <br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> Client <SPAN style="color:#00007F">In</SPAN> rngClients<br>        <SPAN style="color:#00007F">If</SPAN> Client.Value <> "" <SPAN style="color:#00007F">Then</SPAN><br>        <br>            <SPAN style="color:#00007F">Set</SPAN> wsClient = <SPAN style="color:#00007F">Nothing</SPAN><br>            <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>                <SPAN style="color:#00007F">Set</SPAN> wsClient = Sheets(Client.Text)<br>            <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>            <SPAN style="color:#00007F">If</SPAN> wsClient <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#00007F">Set</SPAN> wsClient = Sheets.Add(After:=Sheets(Sheets.Count))<br>                wsClient.Name = Client.Text<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <br>            wsAll.Range("B1:B" & LastRow).AutoFilter Field:=1, Criteria1:=Client.Value<br>            <br>            wsAll.Range("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy _<br>                Destination:=wsClient.Range("A" & Rows.Count).End(xlUp).Offset(5)<br>                <br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> Client<br>    wsAll.AutoFilterMode = <SPAN style="color:#00007F">False</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[crashing1912]

Exactly what I needed. Thank you very much AlphaFrog, especially for the quick response! You saved the day!

 

[voyama]

I made use of this code and it works amazing. May I ask for advise on slight change:

In my main sheet, I have 2 columns, client phone number and client name. Code creates new sheet for each of my clients and copies the data. What I am looking is the code to copy to the new sheet only the values from Column A (phone numbers).

Ex:
Column A Column B
555-123-1234 Client A
555-234-1234 Client B
555-999-0987 Client A

System will copy only corresponding values from column A to the new worksheet.

Thank you very much

 

[AlphaFrog]

Change this...

            wsAll.Range("[COLOR="Blue"]2:[/COLOR]" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
                Destination:=wsClient.Range("A" & Rows.Count).End(xlUp).Offset(5)

To this...

            wsAll.Range("[COLOR="Red"]A2:A[/COLOR]" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
                Destination:=wsClient.Range("A" & Rows.Count).End(xlUp).Offset(5)

 

[voyama]

You are the BEST!!!! Thank you so much for a very fast reply. I am a beginner into Excel VBA and have lots to learn. These examples are great help in my learning journey. Thank you again.

 

[AlphaFrog]

You're welcome and thanks for the feedback.

 

[voyama]

If I may ask one more question. I have added 3 lines of code to the body so that after copying data to new sheet, it will save as that sheet as csv file and name it same as name of the sheet.

            wsAll.Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
                Destination:=wsClient.Range("A" & Rows.Count).End(xlUp).Offset(1)
            
           [COLOR="Red"] wsClient.Activate
            wsClient.SaveAs Filename:=ThisWorkbook.Path & "\" & wsClient.Name, FileFormat:=xlCSV, CreateBackup:=False
            wsClient.Close SaveChanges:=True[/COLOR]

It is working well except 1 little strange behavior. Basically my workbook gets replaced with last customer csv file. So I have my file called "List.xlsm" and within that I have my main sheet called "ContactList" and a button to run the macro. When I click the button, it runs, all client sheets gets created, the csv files get created. My last client in the list is Masons. So my active list.xlsm gets replaced with Masons.csv. If I do not save as, then my list.xlsm file is back to original stage and does not have new sheets with client namess.

 

[AlphaFrog]

            [color=green]'Save worksheet as CSV[/color]
            wsClient.Copy   [color=green]'copies the worksheet as a new workbook[/color]
            ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & wsClient.Name, FileFormat:=xlCSV, CreateBackup:=[color=darkblue]False[/color]
            ActiveWorkbook.Close SaveChanges:=[color=darkblue]False[/color]
            
            [color=green]'Delete worksheet[/color]
            Application.DisplayAlerts = [color=darkblue]False[/color]
                wsClient.Delete
            Application.DisplayAlerts = [color=darkblue]True[/color]

 

[voyama]

Thank you!