Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
704to708
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
704to708
704to708
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Autofilter kopieren in anderes Blatt

Autofilter kopieren in anderes Blatt
05.12.2005 09:42:16
Dominik
Hallo zusammen!
Bei mir tritt immer folgendes Problem auf:
Tabelle "Server" wir nach der Zahl 1 durchsucht, das ganze wird in Tabelle "Bestelldaten" kopiert.
Nun wird Tabelle "Server" nach Zahl 2 durchsucht, und das ganze wird in "Bestelldaten" kopiert, überschreibt jedoch die Kopien aus den ersten Vorgängen!
Kann man das Problem nicht so lösen, dass er bei den weiteren Suchvorgängen immer in die nächste Freie Zeile schreibt?
Ich poste mal den Code, so wie ich ihn im Programm habe:

Sub BestNeu()
Dim test As Integer
Dim test1 As Integer
Dim lngFilterRow As Long, lngFilterColumn As Long
Dim lngFilter As Long
With Application
.DisplayAlerts = False 'Meldungen aus
.EnableEvents = False 'Ereignisprozeduren aus
.ScreenUpdating = False 'Bildschirmflackern aus
End With
For test1 = 1 To Sheets.Count
If Sheets(test1).Name = "Bestelldaten" Then Sheets(test1).Delete
Next test1
Application.DisplayAlerts = True 'Meldungen ein
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Bestelldaten"
'____________________________
' Formblatt erstellen
Range("A1").Select
ActiveCell.FormulaR1C1 = "Lieferant:"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Dell"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Beschreibung"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Bestell-Code"
Range("D2").Select
ActiveCell.FormulaR1C1 = "ArtNr. Lieferer"
Range("E2").Select
ActiveCell.FormulaR1C1 = "ArtNr. Hersteller"
Range("G2").Select
ActiveCell.FormulaR1C1 = "im Korb"
Range("A1:I2").Select
Selection.Copy
Range("A5").Select
ActiveSheet.Paste
Range("A9").Select
ActiveSheet.Paste
Range("A13").Select
ActiveSheet.Paste
Range("A17").Select
ActiveSheet.Paste
Range("A21").Select
ActiveSheet.Paste
Range("A25").Select
ActiveSheet.Paste
Range("b5").Select
ActiveCell.FormulaR1C1 = "Ingram"
Range("b9").Select
ActiveCell.FormulaR1C1 = "Combo"
Range("b13").Select
ActiveCell.FormulaR1C1 = "Wortmann"
Range("b17").Select
ActiveCell.FormulaR1C1 = "Ergotron"
Range("b21").Select
ActiveCell.FormulaR1C1 = "IDS"
Range("b25").Select
ActiveCell.FormulaR1C1 = "Secomp"
Range("a1:b1").Font.Bold = True
Range("a1:b1").Font.Size = 12
Range("a5:b5").Font.Bold = True
Range("a5:b4").Font.Size = 12
Range("a9:b9").Font.Bold = True
Range("a9:b9").Font.Size = 12
Range("a13:b13").Font.Bold = True
Range("a13:b13").Font.Size = 12
Range("a17:b17").Font.Bold = True
Range("a17:b17").Font.Size = 12
Range("a21:b21").Font.Bold = True
Range("a21:b21").Font.Size = 12
Range("a25:b25").Font.Bold = True
Range("a25:b25").Font.Size = 12
Range("a2:g2").Font.Bold = True
Range("a6:g6").Font.Bold = True
Range("a10:g10").Font.Bold = True
Range("a14:g13").Font.Bold = True
Range("a18:g18").Font.Bold = True
Range("a22:g22").Font.Bold = True
Range("a26:g26").Font.Bold = True
Range("A:A").EntireColumn.ColumnWidth = 22.86
Range("F:F").EntireColumn.ColumnWidth = 5.43
For test = 1 To Sheets.Count
If Sheets(test).Name = "Temp" Then Sheets(test).Delete
Next test
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Temp"
'______________________
'Server durchsuchen
Worksheets("Server").Select
If Not ActiveSheet.AutoFilterMode = True _
Then Columns("L:L").AutoFilter
For j = 1 To 7
Select Case j
Case 1
b = "1"
Case 2
b = "2"
Case 3
b = "3"
Case 4
b = "4"
Case 5
b = "5"
Case 6
b = "6"
Case 7
b = "7"
End Select
If WorksheetFunction.CountIf(Range("L:L"), b) > 0 Then
Selection.AutoFilter Field:=1, Criteria1:=b
End If
With Worksheets("Server")
If .AutoFilterMode Then
If .FilterMode Then
With .AutoFilter
lngFilterRow = .Range.Row
lngFilterColumn = .Range.Column
With .Filters
For lngFilter = 1 To .Count
If .Item(lngFilter).On Then Exit For
Next
End With
End With
.Range(.Range(.Cells(lngFilterRow + 1, lngFilterColumn), _
.Cells(lngFilterRow + 1, lngFilterColumn + .AutoFilter.Filters.Count - 1)), _
.Cells(lngFilterRow, lngFilter).End(xlDown)).Copy _
Worksheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
End If
End If
End With
Worksheets("Server").Select
Next j
ActiveSheet.AutoFilterMode = False
'______________________
'ServerZusätze durchsuchen
'______________________
'Workstation durchsuchen
End Sub

Beispieldatei ist hier:
https://www.herber.de/bbs/user/28876.xls
Danke und Gruß, Dominik

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

Betreff
Datum
Anwender
Anzeige
AW: Autofilter kopieren in anderes Blatt
05.12.2005 13:56:18
Harald
Hallo Domink,
erstens...viel zu viele select ;-))
Range("A1").Select
ActiveCell.FormulaR1C1 = "Lieferant:"
geht auch so
Range("A1") = "Lieferant:"
oder:
Range("A1:I2").Select
Selection.Copy
Range("A5").Select
ActiveSheet.Paste
Range("A9").Select
ActiveSheet.Paste
Range("A13").Select
ActiveSheet.Paste
geht auch so
Range("A1:I2").Copy Range("A5, A9, A13")
Zum eigentlichen Problem, tausche
Worksheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
gegen
Worksheets("Temp").Range("A65536").End(xlUp).Row +1
Gruss Harald
Anzeige
AW: Autofilter kopieren in anderes Blatt
05.12.2005 14:16:19
Dominik
Hallo und Danke für die Antwort!
Habe den Quellcode nun so gestaltet:

Sub BestNeu2()
Dim test As Integer
Dim test1 As Integer
Dim lngFilterRow As Long, lngFilterColumn As Long
Dim lngFilter As Long
With Application
.DisplayAlerts = False 'Meldungen aus
.EnableEvents = False 'Ereignisprozeduren aus
.ScreenUpdating = False 'Bildschirmflackern aus
End With
For test1 = 1 To Sheets.Count
If Sheets(test1).Name = "Bestelldaten" Then Sheets(test1).Delete
Next test1
Application.DisplayAlerts = True 'Meldungen ein
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Bestelldaten"
'____________________________
' Formblatt erstellen
Range("A1") = "Lieferant:"
Range("B1") = "Dell"
Range("A2") = "Beschreibung"
Range("C2") = "Bestell-Code"
Range("D2") = "ArtNr. Lieferant"
Range("E2") = "ArtNr. Hersteller"
Range("G2") = "im Korb"
Range("A1:I2").Copy Range("A5, A9, A13, A17, A21, A25")
Range("B5") = "Ingram"
Range("B9") = "Combo"
Range("B13") = "Wortmann"
Range("B17") = "Ergotron"
Range("B21") = "IDS"
Range("B25") = "Secomp"
Range("a1:b1").Font.Bold = True
Range("a1:b1").Font.Size = 12
Range("a5:b5").Font.Bold = True
Range("a5:b4").Font.Size = 12
Range("a9:b9").Font.Bold = True
Range("a9:b9").Font.Size = 12
Range("a13:b13").Font.Bold = True
Range("a13:b13").Font.Size = 12
Range("a17:b17").Font.Bold = True
Range("a17:b17").Font.Size = 12
Range("a21:b21").Font.Bold = True
Range("a21:b21").Font.Size = 12
Range("a25:b25").Font.Bold = True
Range("a25:b25").Font.Size = 12
Range("a2:g2").Font.Bold = True
Range("a6:g6").Font.Bold = True
Range("a10:g10").Font.Bold = True
Range("a14:g13").Font.Bold = True
Range("a18:g18").Font.Bold = True
Range("a22:g22").Font.Bold = True
Range("a26:g26").Font.Bold = True
Range("A:A").EntireColumn.ColumnWidth = 22.86
Range("F:F").EntireColumn.ColumnWidth = 5.43
For test = 1 To Sheets.Count
If Sheets(test).Name = "Temp" Then Sheets(test).Delete
Next test
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Temp"
'______________________
'Server durchsuchen
'______________________
'ServerZusätze durchsuchen
Worksheets("ServerZusätze").Select
If Not ActiveSheet.AutoFilterMode = True _
Then Columns("L:L").AutoFilter
For j = 1 To 7
Select Case j
Case 1
b = "1"
Case 2
b = "2"
Case 3
b = "3"
Case 4
b = "4"
Case 5
b = "5"
Case 6
b = "6"
Case 7
b = "7"
End Select
If WorksheetFunction.CountIf(Range("L:L"), b) > 0 Then
Selection.AutoFilter Field:=1, Criteria1:=b
End If
With Worksheets("ServerZusätze")
If .AutoFilterMode Then
If .FilterMode Then
With .AutoFilter
lngFilterRow = .Range.Row
lngFilterColumn = .Range.Column
With .Filters
For lngFilter = 1 To .Count
If .Item(lngFilter).On Then Exit For
Next
End With
End With
.Range(.Range(.Cells(lngFilterRow + 1, lngFilterColumn), _
.Cells(lngFilterRow + 1, lngFilterColumn + .AutoFilter.Filters.Count - 1)), _
.Cells(lngFilterRow, lngFilter).End(xlDown)).Copy _
Worksheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
ActiveCell.CurrentRegion.SpecialCells(xlVisible).Copy_
Worksheets("Temp").Range("A65536").End(xlUp).Row 1
End If
End If
End With
Worksheets("ServerZusätze").Select
Next j
ActiveSheet.AutoFilterMode = False
'______________________
'Workstation durchsuchen
End Sub

Doch leider bringt es keinen Erfolg. Es kommt der Fehler:
"Laufzeitfehler '438':
Objekt unterstützt diese Eigenschaft oder Methode nicht".
Beim debuggen springt er auf folgende Zeile:
ActiveCell.CurrentRegion.SpecialCells(xlVisible).Copy_
Worksheets("Temp").Range("A65536").End(xlUp).Row 1
Das + zwischen Row und 1 wird ebenfalls gelöscht. Ist das normal?
Für weitere Hilfe wäre ich sehr sehr dankbar :)
Gruß, Dominik
Anzeige
AW: Autofilter kopieren in anderes Blatt
05.12.2005 14:27:10
Harald
woher kommt das denn plötzlich ?
ActiveCell.CurrentRegion.SpecialCells(xlVisible).Copy_
Worksheets("Temp").Range("A65536").End(xlUp).Row 1
Im ersten Thread war nix davon zu sehen ;-))
Mein Lösungsvorschlag bezog sich hierauf:
.Range(.Range(.Cells(lngFilterRow + 1, lngFilterColumn), _
.Cells(lngFilterRow + 1, lngFilterColumn + .AutoFilter.Filters.Count - 1)), _
.Cells(lngFilterRow, lngFilter).End(xlDown)).Copy _
Worksheets("Temp").Range("A65536").End(xlUp).Row + 1 'hier !!
Gruss Harald
AW: Autofilter kopieren in anderes Blatt
05.12.2005 14:49:35
Dominik
Sorry, mein Fehler :)
Hatte da was falsch eingefügt, habe es nun richtig gestellt.
Hier:
With Worksheets("ServerZusätze")
If .AutoFilterMode Then
If .FilterMode Then
With .AutoFilter
lngFilterRow = .Range.Row
lngFilterColumn = .Range.Column
With .Filters
For lngFilter = 1 To .Count
If .Item(lngFilter).On Then Exit For
Next
End With
End With
.Range(.Range(.Cells(lngFilterRow + 1, lngFilterColumn), _
.Cells(lngFilterRow + 1, lngFilterColumn + .AutoFilter.Filters.Count - 1)), _
.Cells(lngFilterRow, lngFilter).End(xlDown)).Copy _
Worksheets("Temp").Range("A65536").End(xlUp).Row + 1
End If
End If
End With
Doch leider bleibt der Fehler bei der Zeile
Worksheets("Temp").Range("A65536").End(xlUp).Row + 1
Noch einen Ansatz, was nicht richtig sein könnte?
Datei habe ich hier nochmal hochgeladen:
https://www.herber.de/bbs/user/28969.xls
Danke & Gruß, Dominik
Anzeige
Keine weitere Idee
05.12.2005 15:37:48
Harald
Sorry
Gruß
Harald
AW: Autofilter kopieren in anderes Blatt
05.12.2005 16:23:29
Kurt
Worksheets("Temp").Range("A65536").End(xlUp).Offset(1,0)
mfg Kurt
AW: Autofilter kopieren in anderes Blatt
05.12.2005 16:55:36
Dominik
Hallo Kurt!
Sorry, aber so war die Zeile schon am Anfang. Jetzt kommt zwar keine Fehlermeldung mehr, aber die Eintragungen in "Temp" werden trotzdem überschrieben.
Einen (traurigen) Gruß, Dominik
AW: Autofilter kopieren in anderes Blatt
05.12.2005 20:45:43
Kurt
Hi,
glaub ich nicht, lad mal was hoch.
mfg Kurt

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige