Zeile in mehrere Tabellenblätter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Beispiel() Dim ArrTab Dim i As Integer ArrTab = Array("Übersicht", "Tabelle2", "Tabelle3") For i = Lbound(ArrTab) To Ubound(ArrTab) With Sheets(ArrTab(i)) 'Kennwort angeben, siehe auch in der Hilfe .Protect "kennwort", UserinterFaceOnly:=True 'Dein Code zum kopieren (Beispiel) 'vor jedes Range- Objekt einen Punkt davorsetzen, damit sich der Bereich auf die 'mit With festgelegt Tabelle bezieht .Rows("5:5").Cut Destination:=.Rows("7:7") End With Next i End Sub

Sub Einfuegen_Zeile() 'Fügt eine Zeile ein Dim Zeile As Long, wks As Worksheet Zeile = ActiveCell.Row Set wks = ActiveSheet With wks 'Zeilen prüfen (nicht oberhalb der 1. Zeile eine Zeile einfügen - wegen Summenformel) If Zeile > .Range("Startzeile_Gesamtübersicht").Row And _ Zeile Worksheets("Zimmertür").Range("Endzeile_Zimmertür").EntireRow.Copy .Range(Zeile).Insert shift:=xlDown Application.CutCopyMode = False Cells(.Row - 1, 2).Select End With End If Else MsgBox "Nur vor Zeilen " & .Range("Startzeile_Gesamtübersicht").Row + 1 & " bis " _ & .Range("Endzeile_Gesamtübersicht").Row & " darf eine Position eingefügt werden!", _ vbInformation + vbOKOnly, _ "Positionszeile - Einfügen" End If End With End Sub

Sub Einfuegen_Zeile() Dim Zeile As Long, wks As Worksheet Dim IndexTab As Integer, lngZeile As Long lngZeile = ActiveCell.Row 'Zeilen prüfen (nicht oberhalb der 1. Zeile eine Zeile einfügen - wegen Summenformel) If lngZeile > Range("Startzeile_Gesamtübersicht").Row And _ lngZeile <= Range("Endzeile_Gesamtübersicht").Row Then If MsgBox("Vor Zeile " & lngZeile & " eine Zeile einfügen?", vbQuestion + vbYesNo, _ "Zeile - Einfügen") = vbYes Then Rows(lngZeile).EntireRow.Copy Rows(lngZeile).EntireRow.Insert Shift:=xlDown IndexTab = ActiveSheet.Index IndexTab = IIf(IndexTab = 1, 2, 1) With Sheets(IndexTab) .Rows(lngZeile).EntireRow.Copy .Rows(lngZeile).Insert Shift:=xlDown End With Application.CutCopyMode = False End If Else MsgBox "Nur vor Zeilen " & Range("Startzeile_Gesamtübersicht").Row + 1 & " bis " _ & Range("Endzeile_Gesamtübersicht").Row & " darf eine Position eingefügt werden!", _ vbInformation + vbOKOnly, "Positionszeile - Einfügen" End If End Sub Sub Loeschen_Zeile() Dim IndexTab As Integer, lngZeile As Long lngZeile = ActiveCell.Row 'Zeilen prüfen (letzte und erste Zeile darf nicht gelöscht werden) If lngZeile > Range("Startzeile_Gesamtübersicht").Row And _ lngZeile < Range("Endzeile_Gesamtübersicht").Row Then If MsgBox("Zeile " & lngZeile & " löschen?", vbQuestion + vbYesNo, "Positionszeile - Löschen") = vbYes Then Rows(lngZeile).Delete Shift:=xlShiftUp IndexTab = ActiveSheet.Index IndexTab = IIf(IndexTab = 1, 2, 1) Sheets(IndexTab).Rows(lngZeile).Delete Shift:=xlShiftUp End If Else MsgBox "Nur Zeilen von Nummer " & Range("Startzeile_Gesamtübersicht").Row + 1 & " bis " _ & Range("Endzeile_Gesamtübersicht").Row - 1 & " dürfen gelöscht werden!", _ vbInformation + vbOKOnly, "Positionszeile - Löschen" End If End Sub

Hallo,
in ArrayTab die Tabellen entsprechend angeben wo die Zeile eingefügt oder gelöscht werden soll.

Sub Einfuegen_Zeile()
Dim Zeile As Long, wks As Worksheet
Dim IndexTab As Integer, lngZeile As Long
Dim ArrayTab

'hier die die Tabellen entsprechend angeben 
ArrayTab = Array("Gesamtübersicht", "Zimmertür")

lngZeile = ActiveCell.Row

    'Zeilen prüfen (nicht oberhalb der 1. Zeile eine Zeile einfügen - wegen Summenformel) 
    If lngZeile > Range("Startzeile_Gesamtübersicht").Row And _
       lngZeile <= Range("Endzeile_Gesamtübersicht").Row Then
        If MsgBox("Vor Zeile " & lngZeile & " eine Zeile einfügen?", vbQuestion + vbYesNo, _
               "Zeile - Einfügen") = vbYes Then
          
            For IndexTab = Lbound(ArrayTab) To Ubound(ArrayTab)
                With Sheets(ArrayTab(IndexTab))
                    .Rows(lngZeile).EntireRow.Copy
                    .Rows(lngZeile).EntireRow.Insert Shift:=xlDown
                End With
            Next IndexTab
            
            Application.CutCopyMode = False
        End If
   Else
      MsgBox "Nur vor Zeilen " & Range("Startzeile_Gesamtübersicht").Row + 1 & " bis " _
          & Range("Endzeile_Gesamtübersicht").Row & " darf eine Position eingefügt werden!", _
          vbInformation + vbOKOnly, "Positionszeile - Einfügen"
    End If

End Sub


Sub Loeschen_Zeile()
Dim IndexTab As Integer, lngZeile As Long

'hier die die Tabellen entsprechend angeben 
ArrayTab = Array("Gesamtübersicht", "Zimmertür")

lngZeile = ActiveCell.Row

    If lngZeile > Range("Startzeile_Gesamtübersicht").Row And _
       lngZeile < Range("Endzeile_Gesamtübersicht").Row Then
        
        If MsgBox("Zeile " & lngZeile & " löschen?", vbQuestion + vbYesNo, _
                  "Positionszeile - Löschen") = vbYes Then
            
            For IndexTab = Lbound(ArrayTab) To Ubound(ArrayTab)
                With Sheets(ArrayTab(IndexTab))
                    .Rows(lngZeile).Delete Shift:=xlShiftUp
                End With
            Next IndexTab
        
        End If
    
    Else
        MsgBox "Nur Zeilen von Nummer " & Range("Startzeile_Gesamtübersicht").Row + 1 & " bis " _
          & Range("Endzeile_Gesamtübersicht").Row - 1 & " dürfen gelöscht werden!", _
          vbInformation + vbOKOnly, "Positionszeile - Löschen"
    End If

End Sub

Gruß Tino

Hallo Tino.
habs eingefügt, bekomme aber folgenden Fehler:
Laufzeitfehler '1004':
"Anwendungs- oder objektdefinierter Fehler"
sobald die "Endzeile_Zimmertüre" kopiert werden soll.

Nur verstehen kann ich dies nicht?
Dann könnte ja diese Zeile auf einmal mitten in der Tabelle sein?!

Das ist so korrekt und gewollt. in dieser Zeile sind ausschließlich Formeln enthalten. In den ersten Spalten (ca. A - F) sind Werte die in der "Gesamtübersicht" eingepflegt werden müssen und dann in den restlichen Tabellenblättern je nach Bedarf abgerufen werden.
Das Kopieren der letzten Zeile soll eine "blanco"-Zeile erzeugen (mit Berechnungsformeln) in der keine manuellen Werten ("Gesamtübersicht") enthalten sind um ein Übernehmen von "alt"-Werten zu vermeiden, da sonst evtl. falsche Werte für eine Berechnung heran gezogen werden.
Kannst du mir evtl. noch mal helfen, damit ich das (letzte Zeile je Tabellenblatt kopieren und einfügen) umsetzen kann.
Vielen Dank noch mal für deine Geduld und die tolle Unterstützung.
Gruß
Josef

Beliebteste Forumthreads (12 Monate)

Zeile in mehrere Tabellenblätter

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeile in mehrere Tabellenblätter

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread