Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
912to916
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
912to916
912to916
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Antwort an Franz(fcs) vom 23.09.

Antwort an Franz(fcs) vom 23.09.
04.10.2007 17:19:00
lisa
Zu deiner Antwort vom 23.09.07
Hallo Franz
Das ist ja wirklich nicht zu glauben.
Ich hatte eine Antwort schon abgeschrieben, heute, durch einen Zufall, finde ich deine Antwort.
Das ist supi und du hast bestimmt eine ganze Weile mit meiner Frage verbracht und keine Antwort von mir bekommen.
Es ist jetzt nachgeholt. DANKE
Ich habe es ausprobiert und es läuft. Recht herzlichen Dank!
Vieleicht, wenn du noch einmal etwas Zeit hast, könntetst du noch einmal schauen, ob es nicht möglich ist, dass nicht der gesamte gefilterte Bereich ausgeschnitten und in Tab2 eingefügt wird sondern nur der erste Datensatz aus dem Criteria- Bereich unter dem Autofilter?
Wenn du Zeit hast.
Liebe Grüße Lisa
Hallo Lisa,
Mit der Methode Cut können nur zusammenhängende Zellebereiche ausgeschnitten und woanders wieder eingefügt werden.
Wenn du gefilterte Daten ausschneiden/einfügen möchtest, dann muss dies zeilen-/blockweise erfolgenden.
Ich hab deine Prozedur mal entsprechend umgestellt. In einer Schleife werden dabei nur die sichtbaren zeilen aausgeschnitten und kopiert. In einer 2. Schleife werden die jetzt leeren Zeilen gelöscht. Für das Prüfen, ob der Autofilter gesetzt ist hab ich eine etwas andere (direktere Methode) verwendet.
MfG
Franz

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Antwort an Franz(fcs) vom 23.09.
05.10.2007 13:30:58
fcs
Hallo Lise,
vielen Dank für das Dankeschön.
Für das Ausschneiden der 1. gefilterten Zeile schaut die Prozedur wie folgt aus. Dazu muss nur der markierte Abschnitt angepasst werden.
Gruß
Franz

Sub DatenübernahmeDatenbank()
Dim wksZiel As Worksheet, wksData As Worksheet
Dim lRow As Long, lZeile As Long, lTest As Long, start As Long
Dim fFilter As Filter, bFilterAktiv As Boolean
Set wksData = Worksheets("Datenbank")
Set wksZiel = Worksheets("Tabelle2")
With wksData
'Prüfen ob Autofilter Aktiv
If .AutoFilterMode = True Then
For Each fFilter In .AutoFilter.Filters
If fFilter.On Then bFilterAktiv = True: Exit For
Next
Else
bFilterAktiv = False
End If
If Not bFilterAktiv Then
MsgBox "Kein Autofilter aktiv!", vbOKOnly + vbExclamation, "kopieren"
GoTo beenden
End If
'Altdaten in Zieltabelle Spalten A bis I löschen ?
lTest = MsgBox("Altdaten in Zieltabelle löschen?", vbQuestion + vbYesNoCancel, _
"Ausschneiden, verschieben")
If lTest = vbYes Then
lRow = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row
If lRow >= 2 Then
wksZiel.Range(wksZiel.Cells(2, 1), wksZiel.Cells(lRow, 9)).ClearContents
End If
ElseIf lTest = vbCancel Then
GoTo beenden
End If
Application.EnableEvents = False
Application.ScreenUpdating = False
'Nächste leere Zeile in Zieltabelle
lRow = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row + 1
'#### Änderung Anfang
'1. gefilterte Zeile ausschneiden und in Zieltabelle einfügen
lTest = .Cells(.Rows.Count, 1).End(xlUp).Row
For lZeile = 3 To lTest
If .Rows(lZeile).Hidden = False Then
.Rows(lZeile).Cut Destination:=wksZiel.Cells(lRow, 1)
Exit For
End If
Next
'#### Änderung Ende
Application.CutCopyMode = False
'leere gefilterte Zeilen löschen
'Prüfen ob noch ausgeblendete Zeilen vorhanden
If .Cells.SpecialCells(xlCellTypeVisible).Count  .Cells.Count Then
.ShowAllData
For lZeile = lTest To 3 Step -1
If IsEmpty(.Cells(lZeile, 1)) Then
start = lZeile
Do Until Not IsEmpty(.Cells(lZeile, 1))
lZeile = lZeile - 1
Loop
.Range(.Rows(lZeile + 1), .Rows(start)).Delete shift:=xlShiftUp
End If
Next
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
.Range("a1").Select
Selection.ClearContents ' ?
MsgBox "Gefilterte Daten wurden nach  " & wksZiel.Name & " kopiert!", _
vbOKOnly + vbInformation, "ausschneiden und verschieben"
End With
With wksZiel
.Activate
' .Range("A3:i120").ClearContents ?
End With
beenden:
Set wksZiel = Nothing: Set wksData = Nothing: Set fFilter = Nothing
End Sub


Anzeige
AW: Antwort an Franz(fcs) vom 23.09.
05.10.2007 14:10:31
lisa
Hallo Franz
Ich habe deine Änderung eingetragen und es klappt 100%ig.
Danke für deine Mühe und deine Zeit.
Danke und ein schönes WE.
Liebe Grüsse Lisa

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige