Filtern von Werten und Kopieren von Daten in neues Blatt

Question

Ich möchte Daten aus einer Excel-Haupttabelle (Blatt 1) ​​in ein neues Blatt (Blatt 2) filtern und verschieben, aber alle Ratschläge, die ich bisher gefunden habe, beziehen sich auf das Filtern nur eine Spalte von Daten und ich möchte zwei verschieben. Ich muss auch nach einem Platzhalter filtern.

Ich habe ein Bild von meinem Blatt 1 angebracht und was ich würde ideal 2.

Spalte A ist Datum im Blatt erstellen möchten; Spalte B ist vom Tiertyp; Spalte C ist Gewicht.

Ich muss durch eine Wildcard filtern alle ‚Pferde‘ in Spalte B zu finden und dann das Datum verschieben, um das Tier Art und das Gewicht zu Tabelle 2.

Ich habe es geschafft, den ersten Teil zu tun mit

=IF(COUNTIF(Sheet1!B2,"*horse*"),Sheet1!B2,"") 

aber ich bin auf dem zweiten Teil des Entfernens aller leeren Zeilen stecken.

Animal weights

Answer 1

dieses versuchen

Option Explicit 

Sub horses() 

With Worksheets("Sheet1").Range("B2:D100") '<== range containing data, headers included 
    .Sort key1:=.Columns(1), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes 
    .AutoFilter field:=2, Criteria1:="*Horse" 
    If WorksheetFunction.Subtotal(103, .Cells) > .Columns.Count Then 
     .SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sheet2").Range("A1") '<== copying form cell "A1" of "Sheet2" 
    End If 
End With 

End Sub 

anpassen kommentierten Zeilen wie pro Sie

Answer 2

Verwenden Sie die unten Funktion, um Ihr Ergebnis muss. Sie können jeden Inhalt für diese Funktion parsen, um das Ergebnis in Sheet2 zu erhalten.

Private Function filtercontent(content As String) As String 
    Lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row 
    For i = 2 To Lastrow 
     If InStr(Cells(i, 2), content) > 0 Then 
      Worksheets("Sheet1").Range("A" & i, "C" & i).Copy 
      With Worksheets("Sheet2") 
       .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues 
      End With 
     End If 
    Next i 
End Function 

oder

Private Function filtercontent(content As String) As String 
    Dim Lastrow As Long 
    Dim i As Integer 
    Lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row 
    For i = 2 To Lastrow 
     If InStr(Cells(i, 2), content) > 0 Then 
      Worksheets("Sheet1").Range("A" & i, "C" & i).Copy Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1) 
     End If 
    Next i 
End Function 

zum Beispiel, wenn Sie wollen, dass die den Filter für Pferde gelten dann

Sub testing() 
    filtercontent ("Horse") 
End Sub