I need VBA that creates a new sheet for every data entered in column D [Solved]

Posts
2
Registration date
Tuesday December 25, 2018
Last seen
December 26, 2018
-
Hi,

I need a formula that create a new sheet for every data in "D" column cells and sheet name is like the cell ,also add that cell whole row data to sheet and if the name is repeted add that row data too, also the new sheet that is created has a format
ex.
d2= temp ---> new sheet: nama=temp / all data from a2:i2 move to new sheet (temp) / with the format that i created new na
d3= coin ---> new sheet: name=coin / all data from a3:i3 move to new sheet (coin) / with the format that i created
d4= temp ---> old sheet: nama=temp / all data from a4:i4 move to old sheet (temp) / with the format that i created
all sheet format are the same but they have some formula
See more 

Your reply

1 reply

Best answer
Posts
11176
Registration date
Monday June 3, 2013
Status
Contributor
Last seen
January 18, 2019
1885
2
Thank you
Does the Code need to check for a sheet named that particular data, too?

Say "Thank you" 2

Glad we were able to help! Love us? Write us a review! Rate CCM

CCM 4463 users have said thank you to us this month

dmatrix00
Posts
2
Registration date
Tuesday December 25, 2018
Last seen
December 26, 2018
-
Yep :)
check them and sum up some of them
ac3mark
Posts
11176
Registration date
Monday June 3, 2013
Status
Contributor
Last seen
January 18, 2019
1885 -
So, let see if I get the whools cope of things.

Read a set line by line.
If a particular word is found in D, then move the row to a sheet named whatever was in D.
Continue to place the data rows onto its own sheet until it is done?
Is this correct?

This should do it:

Function sheetexist(whatsheet)
On Error GoTo NotExists

ThisWorkbook.Worksheets(whatsheet).Select
sheetexist = True
Exit Function

NotExists:
sheetexist = False

End Function

Function testsheet(whichsheet, rowNum)
nret = sheetexist(whichsheet)
If nret = False Then makesheet (whichsheet)
nret = copyrowX(whichsheet, rowNum)
End Function

Sub makesheet(whatsheet)
On Error GoTo ExitSub
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = whatsheet
End With

ExitSub:

End Sub


Function copyrowX(towhatsheet, whatrow)
ThisWorkbook.Worksheets("Sheet1").Select
ThisWorkbook.Worksheets("Sheet1").Range("A" & whatrow).EntireRow.Select
Selection.Copy

ThisWorkbook.Worksheets(towhatsheet).Select
cellcount = Cells(ThisWorkbook.Worksheets(towhatsheet).Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Worksheets(towhatsheet).Range("A" & cellcount).EntireRow.Select
Selection.Insert

End Function


Sub ReadSheet()
cellcount = Cells(ThisWorkbook.Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
For RowCount = 1 To cellcount
cellvalue = ThisWorkbook.Worksheets("Sheet1").Range("A" & RowCount).Value
nret = testsheet(cellvalue, RowCount)
ThisWorkbook.Worksheets("Sheet1").Select
Next
End Sub


You just have to use this paradigm, and apply it to your model.
Respond to ac3mark