Копирование данных во вновь созданный лист на основе значения ячейки

Question

У меня есть журнал действий, в котором пользователи могут выбирать имя собрания, имя пользователя и т. Д. Через форму пользователя с помощью выпадающих списков. Я также создал кнопку, где пользователи могут добавить новое собрание в список со списком.

В настоящее время у меня есть код VBA, который будет проверять значение ячейки на листе 173 (данные, введенные из пользовательской формы), создатьимя нового листа со значением ячейки и скопируйте данные из листа 173 на новый лист. У меня проблема в том, что если добавлено действие и для этого уже создан лист, мне нужно добавить данные в следующую строку этого листа.

У меня работает код доточка, в которой лист уже создан, но необходимо добавить дополнительные строки. Я знаю, что exit sub должен выйти, но я не уверен, что заменить его.

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

Answer 1

Это должно сделать это:

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

Answer 2

Вы уже достаточно близки, попробуйте этот код:

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

Чтобы объяснить: если цикл For находит лист с указанным значением, он установит ws в качестве этого листа и перейдет кFound:, где происходит фактическое копирование и вставка. Если цикл For ничего не находит, он установит ws в качестве нового листа.

Обратите внимание, что ActiveWorkbook и ActiveSheet могут быть склонны вызывать нежелательные ошибки.