Erweiterung
11.06.2015 09:31:27
Hartmut
Folgender Code läuft an sich sehr gut.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Dim Pfad$, Ordner$, FS, Mfile1$, SP%, ZE%, DN%, Letzter%
SP = 6 ' **** Änderungen in Spalte F werden überwacht
ZE = 2 ' **** Änderungen ab Zeile 2 werden überwacht
If Not Intersect(Target, Columns(SP)) Is Nothing And Target.Row >= ZE Then
If Target.Offset(-1, 0) "" Then
Set FS = CreateObject("Scripting.FileSystemObject")
Pfad = "C:\users\user\Documents\handover\"
Mfile1 = "\Final_Handover_.xlsx"
DN = 4 'Spalte mit Ordnernamen hier D
Letzter = IIf(Target.Row = ZE, 0, Right(Cells(Target.Row - 1, DN).Value, 3)) ' _
Letzte Ordner
Ordner = Format(Letzter + 1, """TP_Handover_""000")
Application.EnableEvents = False
Cells(Target.Row, DN).Value = Ordner
Application.EnableEvents = True
If Dir(Pfad & Ordner, vbDirectory) = "" Then
MkDir Pfad & Ordner ' Verzeichnis wird angelegt
FS.copyfile Pfad & Mfile1, Pfad & Ordner & Mfile1, True 'Dateicopy
'FS.copyfile Pfad & Mfile2, Pfad & Ordner & Mfile2, True 'Dateicopy
MsgBox "Ordner angelegt" & vbLf & vbLf & "und Dateien kopiert"
Else
MsgBox "Ordner existiert bereits"
End If
Else
MsgBox "Leerzeile vorher darf nicht sein"
End If
End If
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.EnableEvents = True
End Sub
Es wird ein Excelsheet kopiert und in einen Ordner eingefügt. Es wäre sehr hilfreich für mich wenn in dem Excelsheet welches Kopiert und eingefügt wird die Nummer des erstellten Ordners in der Zelle "O11" eingetragen würde. Kann mir jemand von euch da helfen.
Vielen Dank im voraus.
Gruß
hartmut