Имя листов на основе значения массива, а затем скопировать строки из диапазона с тем же значением, что и имя листа

Question

У меня есть таблица, с которой мне нужно сделать следующее:

1. Получить диапазон столбца fk_keyword
2. Перебрать диапазон и идентифицировать только уникальные значения
3. Перебирать уникальные значения и создавать листы с именами уникальных значений
4. Прокрутите исходный диапазон (fk_keyword) и скопируйте всю строку на лист с соответствующим именем

Например: если значение, найденное в fk_keyword, совпадает с именем листа, то для всех ячеек, соответствующих одному и тому же критерию, вся строка должна быть скопирована на этот лист.

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

Самое близкое совпадение с моим вопросом, которое я нашел, здесь:

VBA - поиск имени листа из диапазона ... затем копирование из листа диапазона, вставка транспонирования в это имя листа

Несмотря на то, что я нашел это, я не использую код в этом примере.

Вместо этого я получил помощь до этого момента по следующим ссылкам:

Копировать всю строку на новый лист:

https://www.extendoffice.com/documents/excel/3723-excel-move-row-to-another-sheet-based-on-cell-value.html

Создание листов из ячейки Excel Значение:

Автоматическое создание листов Excel из значений массива

Удалить дубликаты из массива:

https://wellsr.com/vba/2017/excel/vba-remove-duplicates-from-array/

Итак, вот код, который у меня есть на данный момент:

Функции:

move_Data_To_Sheet

Function move_Data_To_Sheet(myArray As Variant)

    'Dim variables
    Dim xRg As Range, xCell
    Dim I As Long, J, K, Counter
    Dim tmpltWkbk As Workbook
    Dim ws1 As Worksheet

    'Set variables
    Set xRg = find_Header("fk_keyword")
    Set tmpltWkbk = Workbooks("New DB.xlsm")
    Set ws1 = tmpltWkbk.Sheets("TableSheet")

    'Get the row count of the primary sheet
    I = ws1.UsedRange.Rows.Count

    Counter = 0

    'loop through each element in my array
    For Each c In myArray

        'Check that that element is not empty
        If c <> "" Then

            'Add a new sheet after the active sheet
            Sheets.Add After:=ActiveSheet

            'Name the new sheet the same as the current element name in the array
            ActiveSheet.Name = c

            'Get the row count of the new sheet
            J = Worksheets(c).UsedRange.Rows.Count

            'Check if the value is 1
            If J = 1 Then

               'Check if the value is 0
               If Application.WorksheetFunction.CountA(Worksheets(c).UsedRange) = 0 Then

                'J is actually empty
                J = 0

               End If

            End If

            'Loop through the specific range (fk_keyword) on the primary sheet
            For K = 1 To xRg.Count

                'Check if the element matches the current element in the first array
                If CStr(xRg(K).Value) = c Then

                    'Copy the entire row from the primary sheet to the newly added sheet
                    xRg(K).EntireRow.Copy Destination:=Worksheets(c).Range("A" & J + 1)

                    'Delete the row from the primary sheet
                    xRg(K).EntireRow.Delete

                    'Increment J
                    J = J + 1

                    'Increment the counter
                    Counter = Counter + 1

                End If

            'Next element in the array
            Next

        End If

    'Next element in the array
    Next c

End Function

Ниже описана проблема, с которой я столкнулся.

Когда данные копируются на новые листы на основе значения ячейки (KW ID), кажется, что копируются только некоторые данные, а не все.

Например, на рисунке ниже приведены итоговые значения для числовых значений, найденных в столбце fk_keyword на моем листе. Эти числовые значения: KW ID , а общее количество - сколько раз они появляются в столбце fk_keyword .

Теперь, когда я копирую данные на новые листы, вместо того, чтобы скопировать все данные, он будет копировать что-то вроде этого:

• Для KW ID 5: 11 строк
• Для KW ID 9: 15 строк
• Для KW ID 10: 13 строк

И так далее. Но ни один идентификатор KW со всеми его строками не был скопирован, и я не могу понять, почему.