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

[Closed]
Report
Posts
12
Registration date
Monday December 23, 2013
Status
Member
Last seen
January 1, 2014
-
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
-
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

1 reply

Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
803
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