Makro abhängig von Zelleninhalt

Option Explicit 'Vorlage öffnen Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Application.Intersect(Target, [B6:B255]) Is Nothing Then ActiveCell.Select Selection.Copy Workbooks.Add Template:="O:\Vorlage.xlt" Range("S5:Y5").Select ActiveSheet.Paste Application.CutCopyMode = False End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit 'Vorlage öffnen Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim sVorlage As String, sPfad As String 'sPfad = "O:" sPfad = "C:\Users\Public\Test" If Not Application.Intersect(Target, [B6:B255]) Is Nothing _ And Target.Cells.Count = 1 Then Select Case Target.Offset(0, 1).Value 'Werte in Spalte C (rechte Nachbarspalte von B) Case "A", "B" 'alle gültige Einträge für Spalte C - Schreibweise (Groß/Klein beachten)! Select Case Target.Offset(0, 1).Value Case "A": sVorlage = "VorlageA.xlt" Case "B": sVorlage = "VorlageB.xlt" End Select Workbooks.Add Template:=sPfad & "\" & sVorlage Target.Copy Destination:=ActiveSheet.Range("S5:Y5") ActiveSheet.Range("S5").Select 'Nicht unbedingt erforderlich Application.CutCopyMode = False Case Else 'do nothing End Select End If End Sub

Option Explicit 'Vorlage öffnen Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim sVorlage As String, sPfad As String 'sPfad = "O:" sPfad = "O:\Draft\Workload" If Not Application.Intersect(Target, [B2:B255]) Is Nothing _ And Target.Cells.Count = 1 Then Select Case Target.Offset(0, 1).Value 'Werte in Spalte C (rechte Nachbarspalte von B) Case "E", "V", "V-E" 'alle gültige Einträge für Spalte C - Schreibweise (Groß/Klein _ beachten)! Select Case Target.Offset(0, 1).Value Case "E": sVorlage = "E_Vorlage.xlt" Case "V": sVorlage = "V_Vorlage.xlt" Case "V-E": sVorlage = "VE_Vorlage.xlt" End Select Workbooks.Add Template:=sPfad & "\" & sVorlage Target.Copy Destination:=ActiveSheet.Range("S4:Y4") ActiveSheet.Range("S4").Select 'Nicht unbedingt erforderlich Application.CutCopyMode = False Case Else 'do nothing End Select End If End Sub

Hallo Al,
das gewünschte Verzeichnis zum Speichern kannst du einer Variablen zuordnen. Entweder für jeden Case oder einmalig zu Beginn der Prozedur.
Sicherheitshalber hab ich auch den Wechsel des aktuellen Laufwerks eingebaut.
Gruß
Franz

'Vorlage öffnen
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sVorlage As String, sPfad As String, sPfadSpeichern As String, sLaufwerk As String
sPfad = "O:\Draft\Workload"
If Not Application.Intersect(Target, [B2:B255]) Is Nothing _
And Target.Cells.Count = 1 Then
Select Case Target.Offset(0, 1).Value 'Werte in Spalte C (rechte Nachbarspalte von B)
Case "E", "V", "V-E" 'alle gültige Einträge für Spalte C - Schreibweise (Groß/Klein _
beachten)!
Select Case Target.Offset(0, 1).Value
Case "E"
sVorlage = "E_Vorlage.xlt"
sPfadSpeichern = "C:\Users\Public\Test\01"
Case "V"
sVorlage = "V_Vorlage.xlt"
sPfadSpeichern = "C:\Users\Public\Test\Daten"
Case "V-E"
sVorlage = "VE_Vorlage.xlt"
sPfadSpeichern = "C:\Users\Public\Test\Archiv"
End Select
Workbooks.Add Template:=sPfad & "\" & sVorlage
Target.Copy Destination:=ActiveSheet.Range("S4:Y4")
ActiveSheet.Range("S4").Select 'Nicht unbedingt erforderlich
Application.CutCopyMode = False
'aktuelles Laufwerk wechseln auf Laufwerk des Speicherpfads
sLaufwerk = Left(sPfadSpeichern, 1)
VBA.ChDrive sLaufwerk
'aktuelles Verzeichnis wechseln
VBA.ChDir sPfadSpeichern
Case Else
'do nothing
End Select
End If
End Sub

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro abhängig von Zelleninhalt

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread