Copy Rows to existing Multiple worksheet based on condition and create new worksheet if one does not exist

[RPE]

Good day, I am a new member and have a similar situation but would like to for the code to account for when it finds a value and there is no worksheet. So if no tab exists with the value found in the column then it should create a new sheet with the name, copies header and then the row to the new sheet.

Below is the macro that was provided above. which works until it hits a value that does not have a matching tab.

Code:

Option Explicit

Sub CopyDataToSheets()

Dim copyfromws As Worksheet

Dim copytows As Worksheet

Dim cfrng As Range

Dim ctrng As Range

Dim cflr As Long

Dim ctlr As Long

Dim i As Long

Dim currval As String

Set copyfromws = Sheets("Data")

cflr = copyfromws.Cells(Rows.Count, "B").End(xlUp).Row

' Copy Row of Data to Specific Worksheet based on value in Column E

' Existing Formulas in Columns F through H or J are automatically extended to the new row of data

For i = 2 To cflr

currval = copyfromws.Cells(i, 5).Value

Set copytows = Sheets(currval)

ctlr = copytows.Cells(Rows.Count, "B").End(xlUp).Row + 1

Set cfrng = copyfromws.Range("A" & i & ":E" & i)

Set ctrng = copytows.Range("A" & ctlr & ":E" & ctlr)

ctrng.Value = cfrng.Value

Next



End Sub

 

[RPE]

Apologies, below is the code i am using now. I would also like to modify so it will adjust if a column is added to the Sheets("Report")


CODE:

Sub CopyDataToSheets()

Dim copyfromws As Worksheet

Dim copytows As Worksheet

Dim cfrng As Range

Dim ctrng As Range

Dim cflr As Long

Dim ctlr As Long

Dim i As Long

Dim currval As String



Set copyfromws = Sheets("Report")

cflr = copyfromws.Cells(Rows.Count, "A").End(xlUp).Row

' Copy Row of Data to Specific Worksheet based on value in Column T

' Existing Formulas in Columns F through H or J are automatically extended to the new row of data

For i = 2 To cflr

currval = copyfromws.Cells(i, 20).Value

Set copytows = Sheets(currval)

ctlr = copytows.Cells(Rows.Count, "A").End(xlUp).Row + 1

Set cfrng = copyfromws.Range("A" & i & ":Y" & i)

Set ctrng = copytows.Range("A" & ctlr & ":Y" & ctlr)

ctrng.Value = cfrng.Value

Next



End Sub