bestimmte Zeilenlänge u. nur Zellwerte verschieben
08.04.2005 21:10:46
Jörg
mit unten stehendem Script verschiebe ich einen vorher zu markierenden Bereich von einem Sheet ins andere.
So ist es zurzeit:
mit einem Doppelklick starte ich eine UserForm
dann markiere ich die zu kopierenden Zellen
anschließend wähle ich über eine ComboBox der Userform das Zielscheet aus
und starte unten stehendes Skript über einen Button ebendieser UserForm.
die komlette Zeile einschließlich aller Formatierungen wird verschoben
die UserForm schließt sich
So sollte es sein:
per Doppelklick rüfe ich die UserForm auf
der Doppelklick legt auch die zu kopierende Zeile fest
ich wähle nur noch das Zielsheet aus der ComboBox
und es werden aus den Zellen A-Z die Werte einschließlich Leerzellen verschoben, ohne in der Quell- oder Zielzeile die Formatierung, zulässige Eingaben etc. zu verändern
die UserForm schließt sich
------------------------------------------------------------------------------
UserForm1:
Option Explicit
Private Sub CommandButton1_Click()
Call verschieben(Sheets(Me.ComboBox1.Value))
Me.Hide
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim wb As Worksheet
For Each wb In Worksheets
If wb.Name <> wshVon.Name Then
Me.ComboBox1.AddItem wb.Name
End If
Next wb
End Sub
-------------------------------------------------------------------------------
Modul1:
Option Explicit
Public wshVon As Worksheet
Sub verschieben(wshNach As Worksheet)
Application.EnableEvents = False
' zähle in Spalte 1 die Felder bis zum ersten leeren und setze den Wert gleich i
Dim i As Integer
i = 0
Do
i = i + 1
Loop Until IsEmpty(Sheets(UserForm1.ComboBox1.Value).Cells(i, 1))
' kopiere markierte Felder in Zeile i beginnend mit Spalte 1
Selection.Copy wshNach.Cells(i, 1)
' lösche markierte Felder
Selection.Delete shift:=xlUp
Application.EnableEvents = True
End Sub