繁体   English   中英

在现有行之后将具有特定列且没有标题的过滤行复制到新工作表

[英]Copy filtered rows with specific column without headers to new sheet after existing rows

我有一个源 excel 数据,其列数为“n”,其中包含“x”列组中的重复数据组。 我想将第一组与 header、非空和特定列复制到现有的不同工作表。 对于组的 rest,我想在最后一行之后仅将数据过滤并复制到现有工作表中。

我花了足够的时间寻找统一的解决方案,但还没有运气。 我认为自己是这个领域的新手。

'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

截至目前要过滤的第一部分,将带有标题的选定列复制到新工作表正在工作,但仅从第二组复制数据的第二部分不起作用。

最后,我能够得到答案。 这是需要更正的第二个块的更新代码:

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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM