Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
924to928
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
924to928
924to928
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
nicht ganze zeile sondern nur A:I kopieren
20.11.2007 13:05:00
lisa
Hallo zusammen
Ich habe in meiner Tabelle1 Daten die ich über diesen Code in die Tabelle 2 exportiere!
Das ist auch gut so und funktioniert.
Ich würde aber gern, das nicht mehr die ganze Zeile kopiert wird, sondern nur der Bereich von A:I.
kann mir jemand den Code umstellen bitte.
Ich probiere hier schon den halben Tag drann rum, aber alles was ich erreicht habe ist das gar nichts mehr funktioniert.

Private Sub CommandButton1_Click()
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
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
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
lRow = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row + 1
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
Application.CutCopyMode = False
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
End With
beenden:
Set wksZiel = Nothing: Set wksData = Nothing: Set fFilter = Nothing
End Sub


Liebe Grüße Lisa

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

Betreff
Datum
Anwender
Anzeige
AW: nicht ganze zeile sondern nur A:I kopieren
20.11.2007 13:26:00
Kay
Hallo Lisa,
ist so aus dem Stehgreif probiere das einfach mal:

Private Sub CommandButton1_Click()
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
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
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
lRow = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row + 1
lTest = .Cells(.Rows.Count, 1).End(xlUp).Row
For lZeile = 3 To lTest
If .Rows(lZeile).Hidden = False Then
.Range("A" & lZeile, "I" & lZeile).Cut Destination:=wksZiel.Cells(lRow, 1)
Exit For
End If
Next
Application.CutCopyMode = False
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
End With
beenden:
Set wksZiel = Nothing: Set wksData = Nothing: Set fFilter = Nothing
End Sub


MfG
Kay

Anzeige
AW: nicht ganze zeile sondern nur A:I kopieren
20.11.2007 16:18:07
lisa
Hallo Kay
Das mit dem Stehgreif hat funktioniert.
Herzlichen Dank
Lisa

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige