Spezialfilter aus mehreren Tabellen VBA

Sub Filter_Grapadoras() ' Filter_Grapadoras Makro ' Tastenkombination: Strg+r Dim lngLastRowCSR01 As Long Dim lngLastRowCSR03 As Long Dim lngLastRowCSR04 As Long Dim lngLastRowCSR05 As Long Dim lngLastRow As Long lngLastRowCSR01 = Sheets("CSRH7202015.01.CC").Cells(Rows.Count, 1).End(x1Up).Row lngLastRowCSR03 = Sheets("CSRH7202015.03.CC").Cells(Rows.Count, 1).End(x1Up).Row lngLastRowCSR04 = Sheets("CSRH7202015.04.CC").Cells(Rows.Count, 1).End(x1Up).Row lngLastRowCSR05 = Sheets("CSRH7202015.05.CC").Cells(Rows.Count, 1).End(x1Up).Row lngLastRowKr = Sheets("Criterios").Cells(Rows.Count, 1).End(x1Up).Row lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(x1Up).Row Sheets("Resultado").Select Range("A1").Select Sheets("CSRH7202015.01.CC").Range("A1:F" & lngLastRowCSR01).AdvancedFilter Action:= _ xlFilterCopy, _ CriteriaRange:=Sheets ("Criterios").Range("A2:F &, lngLastRowKr),CopyToRange:= _ Range("A1"), Unique:=False lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(x1Up).Row Sheets("CSRH7202015.03.CC").Range("A1:F" & lngLastRowCSR03).AdvancedFilter Action:= _ xlFilterCopy, _ CriteriaRange:=Sheets ("Criterios").Range("A2:F &, lngLastRowKr),CopyToRange:= _ ("A:" & lngLastRow), Unique:=False lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(x1Up).Row Sheets("CSRH7202015.04.CC").Range("A1:F" & lngLastRowCSR03).AdvancedFilter Action:= _ xlFilterCopy, _ CriteriaRange:=Sheets ("Criterios").Range("A2:F &, lngLastRowKr),CopyToRange:= _ ("A:" & lngLastRow), Unique:=False lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(x1Up).Row Sheets("CSRH7202015.05.CC").Range("A1:F" & lngLastRowCSR03).AdvancedFilter Action:= _ xlFilterCopy, _ CriteriaRange:=Sheets ("Criterios").Range("A2:F &, lngLastRowKr),CopyToRange:= _ ("A:" & lngLastRow), Unique:=False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Luna,
ja, bei Fehlern kann man sich manchmal zum "Schänzchen" suchen, geht mir auch so. Ein Tipp:
Habe ich Tuck im Makro sezte ich mir an bestimmten Stellen im Makro einfach den Befehl Exit sub!!
z.b. vor: Sheets("Resultado").Select - und prüfe ob es wenigstens bis dahin fehlerfrei läuft?
Dann kann man mit Direktfenster oder Msgbox lngLastRowCSR01 sich die einzelnen LastZell Werte ansschauen. Damit prüfe ich ob der Bereich schon mal funktioniert, ohne zu sortieren. Alter Programmierertrick. Auf die Art und Weise kann man Fehler einkreisen. Hängt sich das Makro in der 1. Zeile auf (gelb) dann deaktiviere den Befehl durch ' vor lastZell, sieht so aus: 'lngLastRowCSR01=
Auf die Art und Weise siehst du ob die anderen lastZell Befehle funktionieren. Fehler eingekreist! Tritt die Störung nur bei diesem Blattnamen auf stimmt der Blattname nicht. Bitte Kontrollieren. In Sonderfällen, die ich nicht logisch erklaeren kann, half es mir den Blattnamen direkt aus der Tabelle zu kopieren und ins Makro einzusetzen. Bitte nicht wundern wenn es dann plötzlich funktioniert.
Fehler haben manchmal ihre eigenen Tücken. Ich konnte in 20 Jahren nicht alle logisch erklären!
mfg Piet

Danke Uwe dank der Hilfe in den Foren habe ich das schon geändert. Das Makro läuft auch jetzt. Nicht 100% wie gewollt aber es funktioniert. Das was jetzt noch nicht wie gewünscht funktioniert ist das er nur nach dem Kriterium "NOMBRE" richtig filtert. Wenn ich z.B. nach dem Kriterium "SERIAL" filtern möchte listet es mir in dem Sheet "RESULTADO" alle Maschinen auf. Wenn noch jemand Lust und eine Idee hat bin ich sehr dankbar. Hier mal das Makro was mir jemand grandioserweise schon geschrieben hat.


Sub FilterinPlace()
' Filter_Grapadoras Makro
' Tastenkombination: Strg+r
Dim lngLastRowCSR01 As Long
Dim lngLastRowCSR03 As Long
Dim lngLastRowCSR04 As Long
Dim lngLastRowCSR05 As Long
Dim lngLastRow As Long
lngLastRowCSR01 = Sheets("CSR H720 2015.01.CC").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowCSR03 = Sheets("CSR H720 2015.03.CC").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowCSR04 = Sheets("CSR H720 2015.04.CC").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowCSR05 = Sheets("CSR H720 2015.05.CC").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowKr = Sheets("Criterios").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Resultado").UsedRange.Offset(1).ClearContents
Sheets("CSR H720 2015.01.CC").Range("A1:F" & lngLastRowCSR01).AdvancedFilter Action:= _
xlFilterCopy, _
CriteriaRange:=Sheets("Criterios").Range("A2:F" & lngLastRowKr), CopyToRange:= _
Sheets("Resultado").Range("A1:F1"), Unique:=False
On Error Resume Next
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("CSR H720 2015.03.CC").Range("A1:F" & lngLastRowCSR03)
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Criterios").Range("A2:F" _
& lngLastRowKr)
.Offset(1).Copy Sheets("Resultado").Range("A" & lngLastRow + 1)
Parent.ShowAllData
End With
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("CSR H720 2015.04.CC").Range("A1:F" & lngLastRowCSR04)
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Criterios").Range("A2:F" _
& lngLastRowKr)
.Offset(1).Copy Sheets("Resultado").Range("A" & lngLastRow + 1)
.Parent.ShowAllData
End With
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("CSR H720 2015.05.CC").Range("A1:F" & lngLastRowCSR05)
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Criterios").Range("A2:F" _
& lngLastRowKr)
.Offset(1).Copy Sheets("Resultado").Range("A" & lngLastRow + 1)
.Parent.ShowAllData
End With
Sheets("Resultado").Select
End Sub

Gracias y Saludos
Luna

Beliebteste Forumthreads (12 Monate)

Spezialfilter aus mehreren Tabellen VBA

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

318 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spezialfilter aus mehreren Tabellen VBA

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

318 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread