Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
908to912
908to912
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

statt kopieren auschneiden

Forumthread: statt kopieren auschneiden

statt kopieren auschneiden
20.09.2007 14:04:00
lisa
Hallo zusammen
In diesem Code wird ein Bereich kopiert und in die Tabelle 2 eingefügt.
Wie stelle ich diesen Code so um, dass nicht kopiert sondern ausgeschnitten wird.

Sub DatenübernahmeDatenbank()
Sheets("Tabelle2").Select
Range("a2:I500").ClearContents
Sheets("Datenbank").Select
Const iAnzahlSpalten = 4
Dim lRow As Long
Dim bFilterAktiv As Boolean
For lRow = 1 To iAnzahlSpalten
If Not IsEmpty(ActiveSheet.Cells(1, lRow)) Then bFilterAktiv = True
Next lRow
If Not (bFilterAktiv) Then
MsgBox "Kein Autofilter aktiv!", vbOKOnly + vbExclamation, "kopieren"
Exit Sub
End If
Application.EnableEvents = False
lRow = Sheets("Tabelle2").Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range("3:" & ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row).  _
_
Copy _
Destination:=Sheets("Tabelle2").Cells(lRow, 1)
Application.CutCopyMode = False
MsgBox "Gefilterte Daten wurden nach Tabelle2 kopiert!", vbOKOnly + vbInformation, " _
kopieren"
Application.EnableEvents = True
Range("a1").Select
Selection.ClearContents
Sheets("Tabelle2").Select
Range("A3:i120").ClearContents
End Sub


Danke für die Hilfe
Lisa

Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: statt kopieren auschneiden
20.09.2007 14:07:19
Fred
Hi,
dabei hilft dir dein Freund, der Makrorekorder.
Statt Copy Cut verwenden.
mfg Fred

AW: statt kopieren auschneiden
20.09.2007 14:16:53
lisa
Hallo danke für die schnelle Antwort.
Eigentlich hätte ich ja selbst drauf kommen können.
Nichts für Ungut.
Danke und Gruß Lisa

AW: statt kopieren auschneiden
20.09.2007 15:53:00
lisa
Hallo noch einmal
Ich habe jetzt Copy gegen cut getauscht.
Es sieht nun so aus.

Sub DatenübernahmeDatenbank()
Sheets("Tabelle2").Select
Range("a2:I500").ClearContents
Sheets("Datenbank").Select
Const iAnzahlSpalten = 4
Dim lRow As Long
Dim bFilterAktiv As Boolean
For lRow = 1 To iAnzahlSpalten
If Not IsEmpty(ActiveSheet.Cells(1, lRow)) Then bFilterAktiv = True
Next lRow
If Not (bFilterAktiv) Then
MsgBox "Kein Autofilter aktiv!", vbOKOnly + vbExclamation, "kopieren"
Exit Sub
End If
Application.EnableEvents = False
lRow = Sheets("Tabelle2").Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range("3:" & ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row).  _
_
Cut _
Destination:=Sheets("Tabelle2").Cells(lRow, 1)
Application.CutCopyMode = False
MsgBox "Gefilterte Daten wurden nach Tabelle2 kopiert!", vbOKOnly + vbInformation, " _
kopieren"
Application.EnableEvents = True
Range("a1").Select
Selection.ClearContents
Sheets("Tabelle2").Select
Range("A3:i120").ClearContents
'lRow = Sheets("Tabelle2").Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row + 1
End Sub


Problem hierbei ist nun aber, dass nicht mehr nur der gefilterte Bereich kopiert(ausgescnittenen) wird,
sondern die gesamte Tabelle.
Wo kann ich das umstellen?
Ich habe versucht Application.CutCopyMode = False umzustellen auf True aber das führte zu keinem Ergebnis
Gruß Lisa

Anzeige
AW: statt kopieren auschneiden
23.09.2007 02:00:37
fcs
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

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
'gefilterte Zeilen 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
start = lZeile
Do Until .Rows(lZeile).Hidden = True Or lZeile > lTest
lZeile = lZeile + 1
Loop
.Range(.Rows(start), .Rows(lZeile - 1)).Cut Destination:=wksZiel.Cells(lRow, 1)
lRow = lRow + lZeile - start
End If
Next
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

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige