K
K
Hi all, I am trying to copy filtered data from one sheet to other. I
have created macro (see below) but its not working the way I wanted.
All I need is that I got data in Sheet1 in Range("A2100") and got
headings in Range("A11"). I want to filter data by the value in
Range("F1") and then i want macro to check cloumn D cells value. If
value is "O" then copy visible cells of Range("A:C") into column A
cells of Sheet3 and if value is "R" then copy in column D of Sheet3.
Please see below my macro code for more detail. Please can any friend
help me on this.
Sub TEST()
Dim C As Range
LASTCL = Cells(Rows.Count, "A").End(xlUp).Row
LASTCL2 = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:C1").AutoFilter
Range("A1:C" & LASTCL).AutoFilter Field:=1, Criteria1:=Range
("F1").Value
With Sheets("Sheet3")
..Range("A2:C50000").ClearContents
End With
LASTCL = Cells(Rows.Count, "A").End(xlUp).Row
For Each C In Range("D2" & LASTCL).SpecialCells
(xlCellTypeVisible).Cells
If C.Value = "O" Then
C.Offset(, -3).Resize(, 3).Copy Sheets("Sheet3").Range("A2:A" &
LASTCL2 + 1)
ElseIf C.Value = "R" Then
C.Offset(, -3).Resize(, 3).Copy Sheets("Sheet3").Range("D2" &
LASTCL2 + 1)
End If
Next
Application.CutCopyMode = False
Range("A1").Select
End Sub
have created macro (see below) but its not working the way I wanted.
All I need is that I got data in Sheet1 in Range("A2100") and got
headings in Range("A11"). I want to filter data by the value in
Range("F1") and then i want macro to check cloumn D cells value. If
value is "O" then copy visible cells of Range("A:C") into column A
cells of Sheet3 and if value is "R" then copy in column D of Sheet3.
Please see below my macro code for more detail. Please can any friend
help me on this.
Sub TEST()
Dim C As Range
LASTCL = Cells(Rows.Count, "A").End(xlUp).Row
LASTCL2 = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:C1").AutoFilter
Range("A1:C" & LASTCL).AutoFilter Field:=1, Criteria1:=Range
("F1").Value
With Sheets("Sheet3")
..Range("A2:C50000").ClearContents
End With
LASTCL = Cells(Rows.Count, "A").End(xlUp).Row
For Each C In Range("D2" & LASTCL).SpecialCells
(xlCellTypeVisible).Cells
If C.Value = "O" Then
C.Offset(, -3).Resize(, 3).Copy Sheets("Sheet3").Range("A2:A" &
LASTCL2 + 1)
ElseIf C.Value = "R" Then
C.Offset(, -3).Resize(, 3).Copy Sheets("Sheet3").Range("D2" &
LASTCL2 + 1)
End If
Next
Application.CutCopyMode = False
Range("A1").Select
End Sub