Excel VBA Makro zum filtern der Datei und kopieren Sie Sie auf neue Arbeitsmappe

Ich bin sehr neu in VBA Programmierung und versuche zu schreiben ein VBA-code in excel mit Diesem code werden meine filter Datei Criteria1:="=*001" und kopieren Sie die besonderen Wert auf neue Arbeitsmappe mit dem Namen AV und speichern Sie es. Nun möchte ich auch kopieren Sie alle Werte, wo Criteria1:="<>*001" neue Arbeitsmappe mit dem Namen LC und speichern Sie es.

Hier ist der code, den ich auf dieser website gefunden und versucht, modifiziert es aber nicht sicher, wie Sie Sie verwenden ELSE für Criteria1:="<>*001".

Sub sort()
On Error Resume Next
Application.DisplayAlerts = False

Dim new_book As Workbook
Dim newsheet As Worksheet

With ThisWorkbook.Sheets("NRM_Homing_Upload")  'Replace the sheet name with the raw data sheet name

    Set newsheet = ThisWorkbook.Sheets("TempSheet")

        If newsheet Is Nothing Then
                Worksheets.Add.Name = "TempSheet"
            Else
                ThisWorkbook.Sheets("TempSheet").Delete
                Worksheets.Add.Name = "TempSheet"
        End If

            .Columns("H").Copy

                With ThisWorkbook.Sheets("cal")
                    .Range("A1").PasteSpecial (xlPasteAll)
                    .Columns("H").RemoveDuplicates Columns:=1, Header:=xlYes
                End With

                        For Each cell In ThisWorkbook.Sheets("TempSheet").Columns("a").Cells
                            i = i + 1
                                If i <> 1 And cell.Value <> "" Then
                                    .AutoFilterMode = False
                                    .Rows(1).AutoFilter field:=8, Criteria1:="=*001"
                                    Set new_book = Workbooks.Add
                                    .UsedRange.Copy
                                    new_book.Sheets(1).Range("a1").PasteSpecial (xlPasteAll)
                                    'new_book.SaveAs Filename:=ThisWorkbook.Path & "\" & cell.Value & ".xlsx"
                                    new_book.SaveAs Filename:="C:\Desktop\excel\test\AV.xlsx"
                                    new_book.Sheets(1).UsedRange.Columns.AutoFit
                                    new_book.Save
                                    new_book.Close

                                End If
                        Next cell



                            ThisWorkbook.Sheets("TempSheet").Delete
End With

End Sub

Jede Hilfe ist willkommen.
Dank

Wollen Sie wirklich, um eine Schleife durch alle Zeilen in Spalte A das temp-Blatt und filter jedes mal, wenn eine Zelle <> ""? Oder willst du einfach nur filter zweimal - einmal für =*001 und once for <>*001 und erstellen Sie zwei Arbeitsmappen? Und wie funktioniert das TempSheet bekommen mit Daten gefüllt? Ich sehe in deinem code ist, dass Sie das Blatt, aber es wird nie Daten ausgefüllt.
Was ist im Arbeitsblatt "cal"? warum sind Sie kopieren NRM_Homing_Upload.columns("H") cal.Spalten("A") und dann entfernen der Duplikate von cal.Columns("H")? beim ausführen einer for-Schleife über TempSheet, es sieht aus wie Sie arbeiten, mit einem leeren Blatt, weil man noch nicht alles, was in es noch nicht. Warum sind Sie FÜR die Schleife durch alle Zellen in TempSheet wenn Sie nur zwei Sätze von Werten, die Sie suchen? Die Art und Weise Ihre Aussagen sind, Sie sind autofiltering "NRM_Homing_Upload", nicht tempsheet, ist, dass das, was Sie sind versuchen zu tun?
okay - aber das Sie nur kopieren, Spalte H aus NRM_Homing_Upload zu TempSheet zu Spalte A. Dann entfernen Sie Duplikate aus Spalte H? Meinst du zum entfernen der Duplikate aus Spalte A in TempSheet. Und so Ihr zwei Arbeitsmappen haben nur 1 Spalte mit Daten jedes?
Hallo Scott, ich möchte genau das tun, was du geschrieben hast, aber ich bin nicht sicher, wie das zu tun. Außerdem ist es nicht "cal" seine tempsheet. Sorry habe vergessen es zu ändern. Wenn ich diesen starte, es tut füllen Sie die Daten und speichern Sie es als AV.xlsx. aus dem Blatt "NRM_Homing_Upload" die Filterung der Spalte H auf der Basis von Kriterien und kopieren alle Spalten von A bis S um neue Arbeitsmappe mit den gefilterten Ergebnissen.
Ja, es entfernen Duplikate aus Spalte A in TempSheet

InformationsquelleAutor MGoyal | 2015-11-19

3

Hier ein paar Dinge basierend auf Ihren original-Fragen und Kommentare:
1. Es gibt keine Notwendigkeit, erstellen Sie ein temp-Blatt für diese. Sie können die Liste filtern, in Ort und entfernen Sie die Duplikate nach dem neuen Buch
2. Die Sie nicht brauchen, um eine Schleife durch jede Zelle. Sie können einfach AutoFilter den Datenbereich
3. Da Sie ein neues Buch zweimal, ich legte es in seine eigene sub (und nannte es zweimal) mit Parametern für die Arbeitsmappe und die Auswahl zu kopieren und den Namen der Datei zu speichern.
4. Bewusst sein, wenn mit On Error Resume Next. Sie sollten vermeiden, den es bei allen Kosten, aber wenn Sie unbedingt brauchen, es (und in einigen Fällen, die Sie tun), vergewissern Sie sich zum zurücksetzen des Fehler-Kennzeichnung mit On Error GoTo 0 dem moment, in dem Sie übergeben jeder code, der erfordert Fehler-Unterdrückung. *Beachten Sie, dass meine umgestalteten code nicht enthalten, die Notwendigkeit zu unterdrücken Fehler.
Hier ist der überarbeitete code:
```
Sub sort()

Application.DisplayAlerts = False

Rem Copy Data From NRM_Homing_Upload
With ThisWorkbook.Sheets("NRM_Homing_Upload")

    Dim lRow As Long
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row

    With .Range("A1:H" & lRow)

        .AutoFilter 8, "=*001"

        CopyToNewBook ThisWorkbook, ThisWorkbook.Sheets("NRM_Homing_Upload"), .SpecialCells(xlCellTypeVisible), "AV"

        .AutoFilter 1, "<>*001"

        CopyToNewBook ThisWorkbook, ThisWorkbook.Sheets("NRM_Homing_Upload"), .SpecialCells(xlCellTypeVisible), "LC"

    End With

    .AutoFilterMode = False

End With

End Sub

Sub CopyToNewBook(wb As Workbook, ws as Worksheet, rng As Range, sFile As String)

Dim new_book As Workbook
Set new_book = Workbooks.Add

wb.Sheets(ws.name).Range(rng.Address).Copy

With new_book

    With .Sheets(1)

        .Range("a1").PasteSpecial (xlPasteAll)
        .UsedRange.Columns.AutoFit
        .UsedRange.RemoveDuplicates Columns:=8, Header:=xlYes

    End With

    .SaveAs Filename:="C:\Desktop\excel\test\" & sFile & ".xlsx"
    .Close

End With

End Sub
```
- Dank Scott. Ich versuchte diesen code, aber seine Angabe ein run-time error 424-Objekt erforderlich und die Hervorhebung der "CopyToNewBook " DieseArbeitsmappe", .SpecialCells(xlCellTypeVisible).Kopieren Sie "AV". Ich bin nicht sicher, was vermisse ich hier.
- sorry - ich verließ die .Copy Befehl bei der Einstellung der Bereich. versuchen Sie nun, mit bearbeitet Antworten.
- Scott, Es ist immer noch ein Fehler 438 Objekt unterstützt diese Eigenschaft oder Methode und highlights der wb.Range(rng.Adresse).Kopieren
- sorry, aus meinem Spiel ein bisschen @MGoyal. Siehe editiert Antwort wieder.
- Dank Scott. Es funktionierte perfekt. Das einzige, was ich ändern musste ist, löschen Sie diese Zeile von code .UsedRange.RemoveDuplicates Spalten:=8, Header:=xlYes, weil die Kriterien <>001 wurde wieder mit nur 1 Datensatz statt alle 10 Datensätze.
- toll @MGoyal. markieren Sie bitte als beantwortet 🙂
InformationsquelleAutor Scott Holtzman

Schreibe einen Kommentar

Du musst angemeldet sein, um einen Kommentar abzugeben.