[英]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.