Zellbereich mit anderen Tabellen austauschen ohne

Sub Tabellenbereich_übernehmen() Dim ber As Worksheet Dim ber1 As Worksheet Set ber = Worksheets("A") Set ber1 = Worksheets("Master") On Error Resume Next w = ber1.Range("s1") If w4 = "A" Then ber.Range("A1:m31").Copy ber1.Range("j15:u45").Paste Else ber1.Range("j15:u45").Copy ber.Range("A1:m31").Paste End If End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jürgen,
damit man das umsetzen kann muss du eine 2. Zelle festlegen in der das Blatt der aktuell angezeigten Gruppe gespeichert wird (in meinem Code z.Zt. S2).
Für volle Funktionalität benötigst du 2 Makros.
1. Das Makro das die Daten vom Master ins Gruppenblatt überträgt und die Daten der gewählten Gruppe ins Master lädt. Dieses fügst du in ein allgmeines Modul ein.


Sub Tabellenbereich_übernehmen()
Dim wsMaster As Worksheet
Dim wsGruppe As Worksheet, strMsgBox As String, Fehler As Integer
Const strBereichGruppe As String = "A1:M31"
Const strBereichMaster As String = "J15:V45"
Const strAuswahl As String = "S1" 'Zelle in der Blatt ausgewählt wird
Const strAktuell As String = "S2" 'Zelle in der aktuelles Blatt eingetragen wird
On Error GoTo Fehler
Application.ScreenUpdating = False
Set wsMaster = Worksheets("Master")
If wsMaster.Range(strAuswahl)  wsMaster.Range(strAktuell) Then
'Anderer Tabellenname wurde gewählt
'Daten des Blattes zurückkopieren
Fehler = 1
Set wsGruppe = Worksheets(wsMaster.Range(strAktuell).Value)
wsMaster.Range(strBereichMaster).Copy Destination:=wsGruppe.Range(strBereichGruppe)
'Neue Gruppen Daten Holen
Fehler2:
Fehler = 2
Set wsGruppe = Worksheets(wsMaster.Range(strAuswahl).Value)
wsGruppe.Range(strBereichGruppe).Copy Destination:=wsMaster.Range(strBereichMaster)
wsMaster.Range(strAktuell).Value = wsMaster.Range(strAuswahl).Value
Else
'Daten des Blattes zurückkopieren
Fehler = 3
Set wsGruppe = Worksheets(wsMaster.Range(strAuswahl).Value)
wsMaster.Range(strBereichMaster).Copy Destination:=wsGruppe.Range(strBereichGruppe)
End If
GoTo Ende
Fehler:
strMsgBox = "Fehler " & Err.Number & vbLf & Err.Description & vbLf & "Blattname """
Select Case Fehler
Case 1
strMsgBox = strMsgBox & wsMaster.Range(strAktuell).Value & """ existiert nicht!"
MsgBox strMsgBox
Resume Fehler2
Case 2, 3
strMsgBox = strMsgBox & wsMaster.Range(strAuswahl).Value & """ existiet nicht!"
MsgBox strMsgBox
Case Else
'do nothing
End Select
Ende:
Application.ScreenUpdating = True
Set wsMaster = Nothing: Set wsGruppe = Nothing
End Sub

2. Ein Makro, das auf Eingaben in Zelle S1 im Masterblatt reagiert und dann das 1. Makro startet.
Dieses Makro muss du im VBA-Edito unter der Master-Tabelle einfügen.


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$S$1" Then
Call Tabellenbereich_übernehmen
Target.Offset(1, 0).Select
End If
End Sub

Gruß
Franz

Beliebteste Forumthreads (12 Monate)

Zellbereich mit anderen Tabellen austauschen ohne

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread