Zellen verknüpfen beidseitig bearbeitbar ABER im Großen Stil

Question

Hallo,

im Forum war das Thema schon mal dran.. allerdings für einzelne Zellen (Zellen verknüpfen beidseitig bearbeitbar)

Meine Problemstellung ist folgendermaßen:
Ich habe eine Datenbank mit Namen und weiteren Infos (mehr als 30 Spalten mit verschiedenen Informationen) die ich aufgrund der vielen Spalten
einteilen möchte in verschiedene Tabellenblätter um es übersichtlich zu machen.

Da ich in der besseren Übersicht auch bearbeiten möchte war die Hilfe mit der Zellenverknüpfung super...jedoch wäre es zu aufwendig alle Zellen
miteinander zu verknüpfen.

Ich dachte daran anstatt die Zellen anzugeben zb. die Spalten, um mir die Arbeit zu ersparen. Hat jedoch noch nicht funktioniert.

Hier der derzeitig funktionierende Code zum Testen:


Option Explicit

'Grundprogramm
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ERRORHANDLER



'Verbindung zwischen A1 und A5
If Target.Cells.Address = "$A$1" Then
Range("A5") = Range("A1")
ElseIf Target.Cells.Address = "$A$5" Then
Range("A1") = Range("A5")
End If




'Grundprogramm
ERRORHANDLER:
Application.EnableEvents = True

End Sub

Habe es bisher nicht hinbekommen die Zellen zu Verknüpfung auf verschiedenen Tabellenblättern, sowie die Verknüpfung von mehr als einer Zelle auf
einmal (optimalerweise die Spalten wie oben schon erwähnt).

Es wäre der Hammer wenn Ihr mir da helfen könnt.
Liebe Grüße
Jamin

Answer 1

Hallo,

hier mal ein Beispiel wie dein Code in Tabelle1 aussehen könnte:

Private Sub Worksheet_Change(ByVal Target As Range)

'Nur wenn in Spalten A bis E etwas eingegeben wird
If Not Intersect(Target, Range("A:E")) Is Nothing Then

'dann aus Spalten A bis E in Eingabezeile der Tabelle1 in die Spalten A bis E in Tabelle2 kopieren, jedoch 4 Zeilen weiter unten
With ThisWorkbook.Worksheets("Tabelle2")
.Range(.Cells(Target.Row + 4, 1), .Cells(Target.Row + 4, 5)) = ThisWorkbook.Worksheets("Tabelle1").Range(Cells(Target.Row + 4, 1), Cells(Target.Row, 5)).Value
End With

End If

End Sub

Da du das ja anscheinend wechselseitig machen willst, musst du in das VBA-Projekt des Tabellenblatts 2 noch einen entsprechend angepassten Code einfügen.

Gruß

M.O.

Answer 2

Hallo M.O.

Vielen Dank für deinen Code!! Der ist super!
Hab nur den Versatz um 4 entfernt.

Eine Sache hab ich noch...
wenn ich in einer Tabelle mehrere Zellen auf einmal lösche wird immer nur der angrenzende erste nach der zuerst selektierten Zelle mit übertragen. Alle
anderen fallen unter den Tisch.
Zum Beispiel: Auswahl A1 und ziehe den Bereich bis D4 dann alle inhalte entfernen. Übertragen wird: A1 löschen und je nachdem ob ich zuerst nach rechts
oder unten gezogen habe A2 oder B1. A3, A4,B2,B3,B4, usw. werden nicht übertragen.

Gibt es da eine Anpassungsmöglichkeit? Falls nicht eine Sperre für mehrere Zellen auswählen oder so?
Oder falls es das auch nicht gibt eine message box die mir bei auswahl mehrerer eine Warnung ausspuckt?

Hier der aktuelle Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'Nur wenn in Spalten A bis E etwas eingegeben wird
If Not Intersect(Target, Range("A:E")) Is Nothing Then

'dann aus Spalten A bis E in Eingabezeile der Tab1in die Spalten A bis E in Tab2 kopieren
With ThisWorkbook.Worksheets("Tab2")
.Range(.Cells(Target.Row, 1), .Cells(Target.Row, 5)) = ThisWorkbook.Worksheets("Tab1").Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Value
End With

End If

End Sub


Danke,
Gruß
Jamin

Answer 3

Hallo Jamin,

schau mal, ob der folgende Code so funktioniert, wie du willst:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim zeile1 As Long
Dim zeile2 As Long

'Nur wenn in Spalten A bis E etwas eingegeben wird
If Not Intersect(Target, Range("A:E")) Is Nothing Then

'erste und letzte zeile des markierten Bereiches in Variablen schreiben
zeile1 = Selection.Row
zeile2 = Selection.Row + Selection.Rows.Count - 1

'dann aus Spalten A bis E in Eingabezeile(n) der Tab1 in die Spalten A bis E in Tab2 kopieren
With ThisWorkbook.Worksheets("Tab2")
.Range(.Cells(zeile1, 1), .Cells(zeile2, 5)) = ThisWorkbook.Worksheets("Tab1").Range(Cells(zeile1, 1), Cells(zeile2, 5)).Value
End With

End If

End Sub

Gruß

M.O.

Answer 4

Hallo M.O.

Danke für deine Antwort und sorry für meine späte:)

Dein Code funktioniert genau so wie ich es beschrieben habe, SUPER, Danke, :)

Bei meiner Beschreibung habe ich allerdings vergessen zu schreiben dass diese löschfunktion unabhängig von der Übertragunsfunktion laufen sollte.
Ist das möglich zu kombinieren? Dass zum einen Einzeln bearbeitete Zellen übertragen werden sowie die übertragen von mehreren ausgewählten und
bearbeiteten zellen?

Liebe Grüße,