Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
700to704
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
700to704
700to704
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Markierung

Markierung
30.11.2005 13:50:48
Marcus
Guten Tag!
Ich habe ein kleines Problem...
Und zwar habe ich hier eine Datei, wenn ich der einen Autofilter aufsetze und per Makro sage dass alle Zellen kopiert werden sollen, werden wirklich ALLE zellen (auch die leeren) kopiert und in ein neues Blatt eingefügt.
Nun 3 Fragen:
1. Wie bekomme ich es hin, dass nur die Zeilen kopiert werden, in denen auch etwas steht?
2. Die Zeile 1 darf nicht mitkopiert werden. Geht das?
3. Wie bekomme ich es hin, dass, nachdem alles in ein neues Blatt kopiert wurde, die Markierung in die nächste freie Zeile Spalte A springt? (Also wenn die Zeilen bis A15 kopiert wurden soll der Cursor in A16 springen) Da die Anzahl der kopierten Zeilen variiert komme ihc nicht weiter.
Für hilfreiche Antworten wäre ich sehr dankbar!
MfG Marcus

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Markierung
30.11.2005 15:01:16
Werner
Hallo Marcus,
versuch mal durch den Makro unten durchzusteigen.
mfg
W.Janz
------------------------------------

Sub copyFilterList()
Dim rngInput As Range
' Filterbereich festlegen
Set rngInput = Worksheets("Tabelle1").Range("a1").CurrentRegion
' Erst mal gucken, ob überhaupt was gefiltert wurde
Set rngInput = rngInput.SpecialCells(xlCellTypeVisible)
If rngInput.Rows.Count = 1 And rngInput.Areas.Count = 1 Then
MsgBox "War wohl nix", vbCritical
Exit Sub
End If
' Wieder alle Zellen betrachten
Set rngInput = rngInput.CurrentRegion
' Kopfzeile ausblenden
Set rngInput = Range(rngInput.Rows(2), rngInput.Rows(rngInput.Rows.Count)).Cells
' Gefilterte Zeilen noch mal auswählen, kopieren und dann den Cursor joggen lassen
Set rngInput = rngInput.SpecialCells(xlCellTypeVisible)
rngInput.Copy Destination:=Worksheets("Tabelle2").Range("A2")
Worksheets("Tabelle2").Activate
' Funktioniert nur , falls in Zeile 1 eine Überschrift steht
Range("A1").End(xlDown).Offset(1, 0).Select
End Sub

Anzeige
Gefilterte Liste sichtbare Zeilen kopieren
30.11.2005 23:27:26
Beate
Hallo Marcus,
Guckst Du: Gefilterte Listen kopieren
Und damit es in die erste freie Zelle in Spalte A kopiert folgende Zeile ersetzen:
Cells(lngFilterRow, lngFilter).End(xlDown)).Copy _
Worksheets("Tabelle2").Range("A1")
durch:
.Cells(lngFilterRow, lngFilter).End(xlDown)).Copy _
    Worksheets("Tabelle2").Range("A65536").End(xlUp).Offset(1, 0)

Gruß,
Beate
Anzeige
AW: Gefilterte Liste sichtbare Zeilen kopieren
01.12.2005 12:26:26
Marcus
Hallo! Erstmal Danke für die Antworten!
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

Es tritt immernoch 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!
Wenn wir das abschaffen könnten wäre mein Problem gelöst :)
Beispieldatei ist hier:
https://www.herber.de/bbs/user/28876.xls
Danke und Gruß!
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige