Копировать отфильтрованные строки с определенным столбцом без заголовков на новый лист после существующих строк - PullRequest
0 голосов
/ 18 октября 2019

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

Я потратил достаточное количество времени на поиск унифицированного решения, но пока не повезло. Я считаю себя новичком в этой области.

'current property 1: Copy with headers
wsRawData.ShowAllData
FilterRow = Rows("1:1").Find(What:="Current Record Type 1 (50)", LookAt:=xlWhole).Column

With wsRawData
    Intersect(.UsedRange, .Rows("1:" & .Rows.Count)).AutoFilter Field:=FilterRow, Criteria1:="<>"
        .Range("A:A,I:K,C:F,Y:AB,AJ:AJ").Copy

        With wsCurrentProperty.Range("A1")
            .PasteSpecial xlPasteFormats
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial xlPasteValues
        End With

End With'this block works just fine

'current property 2: copy only data
wsRawData.ShowAllData
FilterRow = Rows("1:1").Find(What:="Current Record Type 2 (50)", LookAt:=xlWhole).Column

Dim TotalRange As Range

With wsRawData
    Intersect(.UsedRange, .Rows("1:" & .Rows.Count)).AutoFilter Field:=FilterRow, Criteria1:="<>"
        .Range("A:A,I:K,C:F,AR:AU,BC:BC").Copy ' i need a offset of one row here

        'below logic works just fine and copies beyond existing rows
        Last_Row = wsCurrentProperty.Range("A" & .Rows.Count).End(xlUp).Row

        'MsgBox Last_Row

        With wsCurrentProperty.Range("A" & Last_Row + 1)
            .PasteSpecial xlPasteFormats
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial xlPasteValues
        End With

End With

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

1 Ответ

0 голосов
/ 18 октября 2019

Наконец я смог получить ответ. Вот обновленный код для второго блока, который необходимо исправить:

wsRawData.ShowAllData
FilterRow = Rows("1:1").Find(What:="Current Record Type 2 (50)", LookAt:=xlWhole).Column

With wsRawData

    Intersect(.UsedRange, .Rows("1:" & .Rows.Count)).AutoFilter Field:=FilterRow, Criteria1:="<>"
        .Range("A1:A" & wsRawData.UsedRange.Rows.Count & ",I1:K" & wsRawData.UsedRange.Rows.Count & ",C1:F" & _
            wsRawData.UsedRange.Rows.Count & ",AR1:AU" & wsRawData.UsedRange.Rows.Count & ",BC1:BC" & wsRawData.UsedRange.Rows.Count).Copy 

        Last_Row = wsCurrentProperty.Range("A" & .Rows.Count).End(xlUp).Row

        wsCurrentProperty.Activate

        wsCurrentProperty.Cells(Last_Row + 1, 1).Select

        ActiveSheet.Paste

        ActiveCell.EntireRow.Delete' this line deletes header being copied over instead of using offset

End With
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...