I have a source excel data with 'n' number of columns which contains repeated group of data in groups of 'x' number of columns. I would like to copy first group with header, non empty and specific columns to existing different sheet. For rest of the groups, i would like to filter and copy only data into existing sheet after last row.
I have spent sufficient amount of time looking for unified solution but no luck yet. I consider myself a novice in this area.
'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
As of now first section to filter, copy selected columns with headers to new sheet is working, but second part of copy only data from second group is not working.
Finally, i was able to get an answer. Here is the updated code for second block which needed correction:
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.