Office: Tabelle kopieren mit VBA aber mit abfrage

Guten Tag zusammen

ich habe ein problem mit Excel

ich möchte mit der VBA eine Tabelle kopieren aber mit abfrage


das heißt wenn auf Tabellenblatt 1 in der Zeile A1 das Wort "Zylinder" eingebe, soll die Tabelle von Tabellenblatt 2 (A1:E10) auf das Tabellenblatt 1
kopiert werden

viel dank für ihre hilfe

 

Hallo!

Per WorksheetChange-Ereignis z.B. so:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
If Target = "Zylinder" Then
'Kopiert den Bereich nach B1
Sheets("Tabelle2").Range("A1:E10").Copy Range("B1")
End If
End If
End Sub

 

RE

Super Danke für die antwort, es hat super funktioniert.

Noch eine Frage

kann man auch in der vba eingeben, das wenn ich das Wort Zylinder wieder entferne das dann auch die Tabelle wieder ausgeblendet wird

 

Hallo!

Ja, sicher (ungetestet):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
If Target = "Zylinder" Then
'Kopiert den Bereich nach B1
Sheets("Tabelle2").Range("A1:E10").Copy Range("B1")
Else
Range("B1:F10").ClearContents
End If
End If
End Sub

 

Re

Guten tag zusammen

es hat wie immer super funktioniert

ist es auch möglich mehrere funktionen hintereinander zu schreiben

Also das ist klar

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
If Target = "Zylinder" Then
'Kopiert den Bereich nach B1
Sheets("Tabelle2").Range("A1:E10").Copy Range("B1")
End If
End If
End Sub

und das soll jetzt noch dabei

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
If Target = "Kugel" Then
'Kopiert den Bereich nach B1
Sheets("Tabelle2").Range("A13:E20").Copy Range("B1")
End If
End If
End Sub

nur wenn ich es so untereinander schreibe funktioniert es nicht

vielen dank für die Hilfe

 

Hallo!

Teste mal dies:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Select Case Target
Case "Zylinder"
Sheets("Tabelle2").Range("A1:E10").Copy Range("B1")
Case "Kugel"
Sheets("Tabelle2").Range("A11:E20").Copy Range("B1")
Case "Pyramide"
Sheets("Tabelle2").Range("A21:E30").Copy Range("B1")
Case Else
Range("B1:F10").ClearContents
End Select
End If
End Sub