Werte von Tabelle2 in Tabelle 1
07.02.2017 13:17:23
Tabelle2
ich habe folgende Frage:
Ich bekomme regelmäßig ein Tabellenblatt (Name variabel) zugeschickt, welches vom Aufbau identisch ist wie mein vorhandenes Tabellenblatt (Tabelle1). Das zugesandte Tabellenblatt wird in meine Arbeitsmappe kopiert.
Auf dem zugesandten Tabellenblatt ist ein Commandbutton, der folgenden Code enthält, um die benötigten Werte in meine Tabelle1 zu kopieren:
Private Sub CommandButton10_Click()
pw = InputBox("Passwort?")
If pw = "meins" Then
Set ws = Activeworksheet
Application.ScreenUpdating = False
ActiveSheet.Range("B7:D96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("B7:D96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("R7:U96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("R7:U96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("AJ7:AJ96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("AJ7:AJ96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("BA7:BB96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("BA7:BB96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("BQ7:BR96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("BQ7:BR96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("CH7:CK96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("CH7:CK96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("CY7:DB96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("CY7:DB96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("DP7:DS96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("DP7:DS96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("EG7:ET96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("EG7:ET96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("EX7:FM96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("EX7:FM96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("FP7:GE96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("FP7:GE96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("GI7:GK96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("GI7:GK96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ws.Select
ActiveSheet.Range("GZ7:HI96").Copy
Sheets("Tabelle1").Select
ActiveSheet.Range("GZ7:HI96").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Else
MsgBox "Passwort falsch!"
End If
Application.ScreenUpdating = True
Activeworkbbok.Save
Application.Goto Reference:=ActiveSheet.Cells(1, 1), Scroll:=True
End Sub
Gruß Henno
Anzeige