Mehrfaches Einfügen an flexiblem Ziel

Hallo zusammen,
ich habe mein Problem schon einmal beschrieben, welches ich jedoch zu ungenau beschrieben habe. Deshalb habe ich jetzt nochmal eine neue unkompliziertere Excel Datei erstellt in der mein Problem hoffentlich gelöst werden kann.
https://www.herber.de/bbs/user/144247.xlsm
Im Rechner Blatt kann später in den Zellen A2, A14, G2, G14 per Drop-Downs je zwischen 4 verschiedenen Kalkulationsmethoden unterschieden werden. Dann soll es von der entsprechenden Vorlage den nötigen Bereich kopieren und im Rechner-Blatt jeweils in der selben Reihe, ABER eine Zeile weiter eingefügt werden, und bei Veränderung in der Dropdown Auswahl automatisch aktualisiert werden.
Im Beispiel habe ich jetzt nur mal die Vorlage für das Stanzen erstellt.
Ich hoffe ihr könnt das Makro und das "WorksheetChange" sehen und mir kann so jetzt geholfen werden.
Vielen Dank und freundliche Grüße
Hansi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
ich habe deinen Code nach einigem Überlegen sinnvoll erweitert. Bitte testen ob es so klappt.
Sollten sich die Bereiche aendern kannst du de Bereich ja selbst anpassen.
mfg Piet

'Tabelle Rechnung:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Adr1 = Target.Address(0, 0)
If InStr(Adr1, ":") Then Exit Sub
If Adr1 = "A2" Or Adr1 = "G2" Or _
Adr1 = "A14" Or Adr1 = "G14" Then
Select Case Range(Adr1)
Case "Stanzen": Stanzen
Case "Prägen":  Prägen
Case "Planieren": Planieren
Case "Leerstufe": Leerstufe
Case "Keine Auswahl": Keine_Auswahl
End Select
End If
Fehler:
End Sub

'Modul1
Public Adr1 As String     '26.2.2021  Piet  für Herber Forum
Const ClrZell = 8    'Anzahl zu löschende Zeilen  (keine Auswahl)
'Makro für vierfache FropDown Auswahl
Sub Stanzen()
Sheets("Vorlage").Range("A1:C6").Copy
Sheets("Rechnung").Range("B2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Sub Prägen()
Sheets("Vorlage").Range("E1:G6").Copy
Sheets("Rechnung").Range("H2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Sub Planieren()
Sheets("Vorlage").Range("A16:C15").Copy
Sheets("Rechnung").Range("B14").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Sub Leerstufe()
Sheets("Vorlage").Range("E10:G15").Copy
Sheets("Rechnung").Range("H14").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Sub Keine_Auswahl()
Sheets("Rechnung").Range(Adr1).Offset(0, 1).Resize(ClrZell, 3).ClearContents
End Sub

Beliebteste Forumthreads (12 Monate)

Mehrfaches Einfügen an flexiblem Ziel

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread