Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1672to1676
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
Inhaltsverzeichnis

zeile mit VBA auf mehreren Blättern verschieben

zeile mit VBA auf mehreren Blättern verschieben
31.01.2019 09:39:07
Nefantus
Hallo zusammen,
ich habe ein Makro mit dem kann man eine markierte Zeile mit ALT+Pfeiltasten hoch und runter verschieben.
Jetzt möchte ich das die gleichen Zeile auf Tabelle 5 und Tabelle 6 auch verschoben werden.
Es wäre toll wenn mir einer helfen könnte. Vielen Dank im voraus.
Gruß Nefantus
Sub moveSelection(Optional Direction As String = "up")
On Error GoTo ErrExit
Dim rng As Range, objTarget As Worksheet, objSh As Worksheet
Dim rngMove As Range
Dim lngFirst As Long, lngLast As Long, lngMove As Long, lngOld As Long, lngNew As Long
Dim intMove As Integer
On Error GoTo ErrExit
GMS
Set rng = Selection
Set objTarget = rng.Parent
lngFirst = rng.Cells(1, 1).Row
lngLast = lngFirst + rng.Rows.Count - 1
With objTarget
If LCase(Direction) = "up" Then
If lngFirst = 1 Then GoTo ErrExit
lngMove = lngFirst - 1
lngOld = lngFirst - 1
lngNew = lngLast
intMove = -1
Else
If lngLast = Rows.Count Then GoTo ErrExit
lngMove = lngFirst + 1
lngOld = lngLast + 1
lngNew = lngFirst
intMove = 1
End If
Set objSh = Worksheets.Add
.Range(.Cells(lngOld, 1), .Cells(lngOld, Columns.Count)).Copy objSh.Cells(1, 1)
Set rngMove = .Range(.Cells(lngFirst, 1), .Cells(lngLast, Columns.Count))
rngMove.Copy .Cells(lngMove, 1)
objSh.Range(objSh.Cells(1, 1), objSh.Cells(1, Columns.Count)).Copy .Cells(lngNew, 1)
objSh.Delete
rng.Offset(intMove, 0).Select
End With
ErrExit:
GMS True
Set objSh = Nothing
Set rng = Nothing
End Sub Sub moveUP()
moveSelection
End Sub
Sub moveDOWN()
moveSelection "down"
End Sub
Public Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: zeile mit VBA auf mehreren Blättern verschieben
01.02.2019 18:55:04
Mullit
Hallo,
..kannst ja mal testen...
Option Explicit

Public Sub moveSelection(Optional ByVal opvstrDirection As String = "up")
Dim avntSheetNames() As Variant
Dim rngSelection As Range, objTarget As Worksheet, objSh As Worksheet
Dim rngMove As Range
Dim lngFirst As Long, lngLast As Long, lngMove As Long
Dim lngOld As Long, lngNew As Long, ialngIndex As Long
Dim intMove As Integer

On Error GoTo ErrExit
Call GMS
avntSheetNames = Array("Tabelle5", "Tabelle6") '// <<<<Tabellennamen anpassen....>>>!!!!!!! 
Set rngSelection = Selection
Set objTarget = rngSelection.Parent

lngFirst = rngSelection.Cells(1, 1).Row
lngLast = lngFirst + rngSelection.Rows.Count - 1

If LCase$(opvstrDirection) = "up" Then
    If lngFirst = 1 Then GoTo ErrExit
    lngMove = lngFirst - 1
    lngOld = lngFirst - 1
    lngNew = lngLast
    intMove = -1
Else
    If lngLast = objTarget.Rows.Count Then GoTo ErrExit
    lngMove = lngFirst + 1
    lngOld = lngLast + 1
    lngNew = lngFirst
    intMove = 1
End If

Set objSh = Worksheets.Add
objSh.Visible = xlSheetHidden
For ialngIndex = 0 To Ubound(avntSheetNames) + 1
    If ialngIndex > 0 Then Set objTarget = ThisWorkbook.Worksheets(avntSheetNames(ialngIndex - 1))
    With objTarget
        Call .Range(.Cells(lngOld, 1), .Cells(lngOld, .Columns.Count)).Copy( _
            Destination:=objSh.Cells(1 + ialngIndex, 1))
        Set rngMove = .Range(.Cells(lngFirst, 1), .Cells(lngLast, .Columns.Count))
        Call rngMove.Copy(Destination:=.Cells(lngMove, 1))
        Call objSh.Range(objSh.Cells(1 + ialngIndex, 1), _
            objSh.Cells(1 + ialngIndex, .Columns.Count)).Copy( _
            Destination:=.Cells(lngNew, 1))
    End With
Next
Call objSh.Delete
Call rngSelection.Offset(intMove, 0).Select

ErrExit:
Call GMS(True)
Set objSh = Nothing
Set objTarget = Nothing
Set rngSelection = Nothing
Set rngMove = Nothing
End Sub

Public Sub moveUP()
Call moveSelection
End Sub

Public Sub moveDOWN()
Call moveSelection("down")
End Sub

Public Sub GMS(Optional ByVal opvblnModus As Boolean)
  
  Static slngCalc As Long
  
  With Application
        .ScreenUpdating = opvblnModus
        .EnableEvents = opvblnModus
        .DisplayAlerts = opvblnModus
        .EnableCancelKey = IIf(opvblnModus, 1, 0)
        If Not opvblnModus Then slngCalc = .Calculation
        If opvblnModus And slngCalc = 0 Then slngCalc = -4105
        .Calculation = IIf(opvblnModus, slngCalc, -4135)
        .Cursor = IIf(opvblnModus, -4143, 2)
  End With
  
End Sub


VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel



Code erstellt und getestet in Office 14

Gruß, Mullit
Anzeige
AW: zeile mit VBA auf mehreren Blättern verschieb.
04.02.2019 13:39:31
Nefantus
Danke Mullit Perfekt.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige