CODEWITHSUNDEEP
excelvba
kirsten2911
kirsten2911

Reputation: 15

Copying data into a newly made sheet based on cell value

I have an action log where users can select meeting name, user name, etc through a userform with comboboxes. I have also created a button where users can add a new meeting to the combo box list.

Currently I have a vba code that will check the value of a cell on sheet173 (data entered from userform), create a new sheet named with the cell value and copy the data from sheet173 into the new sheet. The problem I have is that if an action is added and there is already a sheet created for this, I need the data to be added to the next row of that sheet.

I have got the code working up until the point where the sheet is already created but additional rows need to be added. I know the exit sub needs to come out but i'm not sure what to replace it with.

Sub copy_newsheet()

Dim pname
Dim ws As Worksheet

pname = Sheets("Sheet173").Range("A1").Value

For Each ws In ActiveWorkbook.Sheets

    If ws.Name = pname Then
        Exit Sub
    End If

Next ws

Sheets("Sheet173").Range("A1:E1").Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
ActiveSheet.Name = pname

End Sub

Upvotes: 0

Views: 46

Answers (2)

riskypenguin
riskypenguin

Reputation: 2199

You are already pretty close, try this code:

Sub smth()

Dim pname As String
Dim ws As Worksheet, sh As Worksheet

pname = Sheets("Sheet173").Range("A1").Value

For Each sh In ActiveWorkbook.Sheets
    If sh.Name = pname Then
        Set ws = sh
        GoTo Found
    End If
Next sh

    Set ws = Sheets.Add(After:=ActiveSheet)
    ws.Name = pname
Found:
    Sheets("Sheet173").Range("A1:E1").Copy
    ws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End Sub

To explain: If the For loop finds a sheet with the specified namen it will set ws as that sheet and jump to Found:, where the actual copying and pasting happens. If the For loop doesn't find anything it will set ws as a new sheet.

Please note that ActiveWorkbook and ActiveSheet can be prone to causing unwanted errors.

Upvotes: 0

Damian
Damian

Reputation: 5174

This should do it:

Option Explicit
Sub Test()

    Dim pname As String
    'full quallify your ranges, include the workbook
    pname = ThisWorkbook.Sheets("Sheet173").Range("A1").Value 'thisworkbook means the workbook which contains the code

    'with this variable we can know if the worksheet exists or not
    Dim SheetExists As Boolean
    SheetExists = False

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = pname Then SheetExists = True
    Next ws

    'check if it doesn't exist
    If Not SheetExists Then
        'if it doesn't exist, then create the worksheet and give it the name from pname
        With ThisWorkbook
            .Sheets.Add After:=.Sheets(.Sheets.Count)
            .Sheets(.Sheets.Count).Name = pname
        End With
    End If

    'with this variable we can find the last row
    Dim LastRow As Long
    With ThisWorkbook.Sheets(pname)
        'calculate the last row on the pname sheet
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        'equal the value from the pname sheet Range A:E to the sheet173 range A1:E1
        .Range(.Cells(LastRow, "A"), .Cells(LastRow, "E")).Value = ThisWorkbook.Sheets("Sheet173").Range("A1:E1").Value
    End With

End Sub

Upvotes: 1

Related Questions