Filter บน Vba แล้วไม่ต้องการ copy แถวบนสุดมาด้วย

[Totem]

เรียน อาจารย์และเพื่อนสมาชิก

เขียน Vba แล้วติดปัญหา คือ ไม่ต้องการ copy แถวบนสุดมา

Code: Select all

Sub FilterToCriteria1()
With Sheet1
           .AutoFilterMode = False
        With .Range("A1:I1")
        .AutoFilter
        .AutoFilter Field:=5, Criteria1:="14"
        .AutoFilter Field:=8, Criteria1:="<>17"
        
        .Range("A" & Rows.Count).End(xlUp).Select
        .Range(Selection, Selection.End(xlUp)).Select
        .Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Sheet2.Range("a1").PasteSpecial Paste:=xlPasteValues
     
    End With

        Sheet1.ShowAllData
            
            
        With .Range("A1:I1")
        .AutoFilter
        .AutoFilter Field:=5, Criteria1:="14"
        .AutoFilter Field:=9, Criteria1:="<>18"
        
        .Range("A" & Rows.Count).End(xlUp).Select
        .Range(Selection, Selection.End(xlUp)).Select
        .Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        
        Sheet2.Select
        Selection.End(xlDown).Offset(1, 0).Select
        Selection.PasteSpecial xlPasteValues
        
        
            
    End With
    
        Sheet1.ShowAllData
            
        With .Range("A1:I1")
        .AutoFilter
        .AutoFilter Field:=5, Criteria1:="5"
            
        Sheet1.Select
        .Range("A" & Rows.Count).End(xlUp).Select
        .Range(Selection, Selection.End(xlUp)).Select
        .Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        
        Sheet2.Select
        Selection.End(xlDown).Offset(1, 0).Select
        Selection.PasteSpecial xlPasteValues
  
            

    End With

        Sheet1.ShowAllData
            
End With

            
End Sub

ตรง

Code: Select all

.Range(Selection, Selection.End(xlToRight)).Select

ในการทำ Filter ครั้งที่ 2 และครั้งที่ 3

และตอนจบต้องการให้ clear filter ใน sheet1 ออกครับ

ขอบคุณครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

With Sheet1
    .AutoFilterMode = False
    With .Range("A1:I1")
    .AutoFilter
    .AutoFilter Field:=5, Criteria1:="14"
    .AutoFilter Field:=8, Criteria1:="<>17"
    .Range("A1").CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
    With Sheet2
        If .Range("a1") <> "" Then
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                .PasteSpecial Paste:=xlPasteValues
        Else
            .Range("a1:i1").Value = Sheet1.Range("a1:i1").Value
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                .PasteSpecial Paste:=xlPasteValues
        End If
    End With
    Application.CutCopyMode = False
    Sheet1.AutoFilterMode = False
End With

[Totem]

ตัวอย่าง Code ครับ

Code: Select all

With Sheet1
    .AutoFilterMode = False
    With .Range("A1:I1")
    .AutoFilter
    .AutoFilter Field:=5, Criteria1:="14"
    .AutoFilter Field:=8, Criteria1:="<>17"
    .Range("A1").CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
    With Sheet2
        If .Range("a1") <> "" Then
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                .PasteSpecial Paste:=xlPasteValues
        Else
            .Range("a1:i1").Value = Sheet1.Range("a1:i1").Value
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                .PasteSpecial Paste:=xlPasteValues
        End If
    End With
    Application.CutCopyMode = False
    Sheet1.AutoFilterMode = False
End With

ขอบคุณครับ ได้ตามที่ต้องการเลยครับ