Excel VBA

Hallo Leute,
ich bin ganz frisch in dem Thema VBA und stehe etwas auf dem Schlauch. Ich habe bereits versucht, über das Forum auf antworten zu kommen, aber leider nicht so erfolgreich. Hier also mein Problem:
Ich möchte mit einer abfrage á la: Wenn(Oder(A2="erstellen",A2="neu"); starten. Wenn ja, dann soll er eine Datei mit dem Namen "Hallo" aus dem Coumputer abrufen, neu speichern unter einem bestimmten pfad (die Infos für den Speicherort würden in verschiedenen Zellen stehen; Im gleichen Tabellenblatt wie auch das VBA ausgeführt werden würde) abspeichern.
Das sollte dann über einen Button o.ä (da bin ich reltiv flexibel) in einer bestimmten Zelle erscheinen. Aber eben nur, wenn die wenn bedingung erfüllt ist.
Ich hoffe, dass ihr mir da weiterhelfen könnt!
Gruß, Andi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub tt() On Error GoTo Fehler Dim TB1 As Worksheet, DateiAlt As String, DateiNeu As String, Pfad As String, FSO Const APPNAME = "TT" 'anpassen*** Set TB1 = Sheets("Tabelle1") 'aus bestimmtem Blatt Pfad = "x:\temp" 'Quellverzeichnis DateiAlt = "Hallo.xlsx" '**** Pfad = IIf(Right(Pfad, 1) = "\", Pfad, Pfad & "\") 'zur Sicherheit testen auf \ am Ende Set FSO = CreateObject("Scripting.FileSystemObject") With TB1 If .Range("A2").Value = "erstellen" Or .Range("A2").Value = "neu" Then '**** DateiNeu = .Range("B1") & .Range("B2") & .Range("B3") 'Beispiel für das Zielverzeichnis. Bitte anpassen '**** FSO.CopyFile Pfad & DateiAlt, DateiNeu 'Datei kopieren End If End With '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _ & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Sub Hallo_neu_speichern() Dim wks As Worksheet Dim wkbNeu As Workbook Dim strPfadNeu As String, strNameNeu As String Dim strNameVorlage As String Set wks = ActiveSheet strNameVorlage = "C:\Users\Public\Test\Hallo.xlsx" 'Anpassen With wks If .Range("A2").Value = "neu" Or .Range("A2").Value = "bestellen" Then 'prüfen, ob Datei vorhanden If Dir(strNameVorlage) = "" Then MsgBox "Vorlage-Datei" & vbLf & strNameVorlage & vbLf _ & " nicht gefunden", _ vbInformation + vbOKOnly, _ "Datei ""Hallo.xlsx"" öffnen und speichern unter" Else 'Vorlage schreibgeschützt öffnen Set wkbNeu = Application.Workbooks.Open(Filename:=strNameVorlage, ReadOnly:= _ True) strPfadNeu = .Range("B4").Text & .Range("B5").Text 'Zellen anpassen If Right(strPfadNeu, 1) "\" Then strPfadNeu = strPfadNeu & "\" strNameNeu = strPfadNeu & wkbNeu.Name 'Datei unter neuem Namen Speichern wkbNeu.SaveAs Filename:=strNameNeu, FileFormat:=51 '51 = Exceldatei ohne _ Makros End If Else MsgBox "Bedingung in Zelle ""A2"" ist nicht erfüllt", _ vbInformation + vbOKOnly, _ "Datei ""Hallo.xlsx"" öffnen und speichern unter" End If End With End Sub

Hallo Franz,
vielen Dank für den ausführlichen Code! Ich hatte mich in der zwischenzeit selber an einem Code probiert:

Sub kopieren()
Dim Urpsrunsdatei As String
Dim NeueDatei As String
Dim Datei
Dim pfad As String
Ursprungsdatei = "[hier steht der Pfad]"
Datei = Range("C2") & Range("D2")       #in C2 und C3 stehen bestimmte zahlen drin, die teil  _
des
pfades sind, wo die datei dann abgespeichert wird. Die sollen sich dann  _
entsprechend ändern. Also quasi wenn der button o.ä, was das makro auslöst, eine zeile tiefer steht, soll entsprechend C3 und D3 da stehen
pfad = "[hier steht der nicht variable Teil des pfades]
If  Range("A2").Value = "neu" Or Range("A2").Value = "erstellen" then
FileCopy Ursprungsdatei, pfad & Datei
End if
Workbooks.Open Filename:= _   "[Neue Datei]"
ActiveWindow.Visible = False
Windows("[Neue Datei]").Visible = True
End Sub

Mir ist klar, das da wahrscheinlich eine Menge Fehler drin sind, aber ich kann eben leider nicht sagen, was genau.
Mir sind auch noch ein paar andere Fragen zu dem Thema aufgekommen:
- kann ich die verlinkung zum Makro auch quasi wie bei der Funtion Hyperlink() als Text in eine Zelle schreiben?
- wenn das vorherige geht, würde sich dann der zellenbezug vom if und von der Datei automatisch mit ändern?
Gruß
Andi

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread