Previous Topic Next Topic

Macro for copying cells with format from last sheet to new sheet

Closed
gm2612 Posts 12 Registration date Monday December 23, 2013 Status Member Last seen January 1, 2014 - Dec 27, 2013 at 12:17 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Dec 27, 2013 at 11:59 PM
Hello,

My project requires to maintain a database for all customers. I have already obtained an event macro from experts from this forum, which, If a new customer is added, will create a new sheet in the name of the new customer. If the customer is existing, then it will not add a new sheet.

Customer name is typed in cell B5. Master list of existing customer is available in the column G.

Now, my requirement is that, the new sheet has to be created with a pre-determined tabular column in it.

Can anyone please help me to achieve this function? Existing code is given below for your reference. My sincere thanks for all supports and helps.


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$5" Then

Call test

End If

End Sub


Sub test()
Dim nname As String
With Worksheets("sheet1")
nname = .Range("B5")
If .Range("G1").EntireColumn.Find(what:=nname, lookat:=xlWhole) Is Nothing Then
Worksheets.Add
ActiveSheet.Name = nname
.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0) = nname
ActiveSheet.Move after:=Worksheets(Worksheets.Count)
End If
End With
ActiveWorkbook.Save
End Sub
Related:

1 response

Answer 1 / 1
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Dec 27, 2013 at 11:59 PM
try this macro modify to suit you 

Sub test()
Dim nname As String
With Worksheets("sheet1")
nname = .Range("B5")
If .Range("G1").EntireColumn.Find(what:=nname, lookat:=xlWhole) Is Nothing Then
Worksheets.Add
ActiveSheet.Name = nname
.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0) = nname
ActiveSheet.Move after:=Worksheets(Worksheets.Count)
End If
'suppose the column to be coopied is column D
.Range("D1").EntireColumn.Copy
Worksheets(nname).Range("D1").PasteSpecial xlpasteall
End With
ActiveWorkbook.Save
End Sub
0