Макрос Excel: обновить лист или создать новый на основе одного критерия

Question

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

Первый лист моей рабочей книги называется "Входные данные" ; Я копирую и вставляю портфолио клиента в этот чистый лист. Ячейка A2 "Вход" содержит имя клиента.

Второй лист называется "Работа" ; Столбец I "Работа" содержит данные клиента, реорганизованные так, как мне нужно.

Остальные листы названы в честь конкретных клиентов («Джонс, Мэтью», «Смит, Питер» и т.д.).

Я хочу создать макрос, который обновляет лист, заголовок которого совпадает с именем, содержащимся в "Входных данных" A2 . В частности, я хочу скопировать столбец I "Работы" и вставить его в столбец A листа (например, «Джонс, Мэтью»), заголовок которого соответствует "Вход" A2 .

Я также хотел бы, чтобы макрос создавал новый лист, если "Input" A2 не соответствует названию какого-либо из существующих листов (т. Е. Если это новый клиент). Текст в "Input" A2 должен быть названием нового листа (например, «Jones, Sarah» ).

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

Answer 1

Это макрос, который вам нужен.

 Public Sub clients()
    Dim wkb As Workbook
    Dim wks, wks1, wks2 As Worksheet
    Set wkb = ThisWorkbook
    nwks = wkb.Sheets.Count 'Number of sheets on the Workbook
    Set wks = wkb.Sheets("Input")
    clientname = wks.Cells(2, 1) 'Name of the client on cell A2 of Input
    If clientname <> "" Then 'if clientname is not empty
        found = False
        For i = 1 To nwks
            sheetname = wkb.Sheets(i).Name
            If sheetname = clientname Then found = True 'sheet exists
        Next i
        If found = False Then 'If sheet doesn't exist then create it
            With wkb
                Set wks1 = .Sheets.Add(After:=.Sheets(.Sheets.Count))
                wks1.Name = clientname
            End With
        End If
        'Copy column I from work to client name column A
        Set wks1 = wkb.Sheets("Work")
        Set wks2 = wkb.Sheets(clientname)
        wks1.Columns(9).Copy wks2.Columns(1)
    End If
End Sub

Откройте VBA/Macros с помощью ALT+F11, в ThisWorkbook вставьте новый модуль и вставьте код с правой стороны.

Выполните это, щелкая зеленый треугольник.

Я добавил комментарии к коду, чтобы вы поняли, как он работает.

Вы также можете запустить его шаг за шагом, нажав на первую строку, а затем пройдитесь по каждому шагу, нажав F8.