Как скопировать и вставить значения в строку на основе ввода таблицы и вставить их в динамическое имя рабочего листа - PullRequest
Новая
       66

Как скопировать и вставить значения в строку на основе ввода таблицы и вставить их в динамическое имя рабочего листа

0 голосов
/ 15 декабря 2018

У меня есть рабочая тетрадь с двумя листами.Рабочий лист «Компании» содержит динамические строки и с заданными столбцами A - J.

В рабочем листе «Таблица - Сводка» у меня есть сводка уникальных названий компаний, и я использовал код для получения уникальных имениз столбца b на листе «Компании».На листе «Сводная таблица» люди получают назначение на уникальные компании, а листы распределяются в соответствии с тем, на какие компании назначено лицо.Имя которого указано в столбце 3 на листе «Таблица - сводка».

У меня есть код, в котором он создает рабочий лист в соответствии с тем, что было введено в лист «Таблица - сводка» в ячейках.(LastRow, 3).Существует более 10 человек, которые назначены нескольким компаниям, что зависит от того, какое имя вводит владелец в столбце C. См. Рисунок.Я не хочу создавать дубликаты рабочих листов для каждого сотрудника.Я выполнил поиск предложений в Google, например, функцию, которая проверяет, существует ли рабочая таблица, но не имела понятия, что она делает.Если бы я мог получить помощь с этим тоже.Пожалуйста и спасибо.

Как я могу сказать VBA проверить столбцы b в таблице «Сводка», чтобы скопировать и вставить строки с именами клиентов в столбце b таблицы «компании».И поместите его в соответствующий лист правопреемника.

Я очень плохо знаком с VBA.Если бы я был неясен.P Аренда дайте мне знать

enter image description here

enter image description here

enter image description here

Sub GetAssignedCompanies()
    Dim wbMaster As Workbook
    Dim shI As Worksheet
    Dim shS As Worksheet

    Set wbMaster = Workbooks("Workbook1.xlsx")
    Set shI = wbMaster.Worksheets("Companies")
    Set shS = wbMaster.Worksheets("Table - Summary")

    Dim LastRow As Integer
    Dim EndRow As Integer
    Dim aName As String

    LastRow = 4
    EndRow = 2
    While Len(shS.Cells(LastRow, 2).Value) > 0
        aName = shS.Cells(LastRow, 3).Value

        If Not aName = vbNullString Then
            Sheets.Add(After:=Sheets(Sheets.count)).Name = aName
        End If

        LastRow = LastRow + 1
    Wend
End Sub

1 Ответ

0 голосов
/ 15 декабря 2018

Это пример;Вам нужно создать новые рабочие листы для каждого сотрудника, прежде чем запускать этот макрос;Он запишет названия компаний из столбца 1 «Таблица - Сводка» в столбец 1 рабочего листа сотрудника.При необходимости измените имена рабочих листов вашего сотрудника.

'You need to create the individual worksheet before running this macro.
Dim nameShtArr, i As Long, shS As Worksheet, shI As Worksheet

Set shI = ThisWorkbook.Worksheets("Companies")
Set shS = ThisWorkbook.Worksheets("Summary")

nameShtArr = Array("Tom", "Bob", "Joe")

    For i = LBound(nameShtArr) To UBound(nameShtArr)
        With shS.Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)
            .AutoFilter Field:=1, Criteria1:=nameShtArr(i)
        End With

        'Place the company names assigned to the employee in column A.
        shS.Range("B2:B20").SpecialCells(xlCellTypeVisible).Copy Worksheets(nameShtArr(i)).Range("A1")

        'This next section will loop through each company name in the current worksheet and find it in ColB,
        'if it finds the company name it will copy the data in the row to ColJ and paste it into the current worksheet.
        Dim lRow As Long
        lRow = Worksheets(nameShtArr(i)).Range("A" & Rows.Count).End(xlUp).Row

            For Each Cel In Sheets(nameShtArr(i)).Range("A1:A" & lRow)
                Dim fndCel As Range
                Set fndCel = shI.Range("B:B").Find(Cel.Value)
                    If Not fndCel Is Nothing Then
                        fndCel.Offset(, 1).Resize(, 10).Copy Cel.Offset(, 1)
                    End If
            Next Cel
    Next i

    shS.Cells.AutoFilter
...