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

Report
Posts
2
Registration date
Tuesday December 25, 2018
Status
Member
Last seen
December 26, 2018
-
 Blocked Profile -
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

1 reply


Does the Code need to check for a sheet named that particular data, too?
2
Thank you

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

CCM 2889 users have said thank you to us this month

Posts
2
Registration date
Tuesday December 25, 2018
Status
Member
Last seen
December 26, 2018

Yep :)
check them and sum up some of them
Blocked Profile
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.