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

Posts
2
Registration date
Tuesday December 25, 2018
Status
Member
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 

1 reply

Best answer
Posts
13035
Registration date
Monday June 3, 2013
Status
Moderator
Last seen
October 11, 2019
1479
2
Thank you
Does the Code need to check for a sheet named that particular data, too?

Say "Thank you" 2

A few words of thanks would be greatly appreciated. Add comment

CCM 6302 users have said thank you to us this month

dmatrix00
Posts
2
Registration date
Tuesday December 25, 2018
Status
Member
Last seen
December 26, 2018
-
Yep :)
check them and sum up some of them
ac3mark
Posts
13035
Registration date
Monday June 3, 2013
Status
Moderator
Last seen
October 11, 2019
1479 -
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