Datensätze kopieren
28.04.2008 12:09:01
Stephan
ich habe mal wieder folgendes Problem:
In einer Datei ("Überprüfung MDE") im Tabellenblatt "PD`s" importiere ich in den Bereich B2:AF30 externe Daten. Im gleichen Tabellenblatt, Zelle "A37" steht ein Datum (z. B. "28.04.2008") und in Zelle A39 eine Produktions-Linienbezeichnung (hier z. B. "3.5A").
Klicke ich nun auf den "Speichern" Button, soll der Bereich B2:AF30 (ohne Leerzeilen) in Abhängigkeit der Linie und mit dem Datum als Dateinamen in das Verzeichnis "H:\MDE geprüft\2008\Artikellaufzeiten\3.5A" als neue csv-Datei erstellt werden. Ändert sich die Eingabe bei der Linie, z. B. "3.6A", soll dann natürlich im Ordner "3.6A" im o. g. Verzeichnis gesucht werden.
Ist diese Datei dort schon vorhanden, soll eine MsgBox erscheinen "Datei schon vorhanden"und die Speicherung abgebrochen werden, falls nicht , soll der Speichervorgang fortgesetzt werden.
Ich habe mich schon an einem (wahrscheinlich recht laienhaften) Ansatz versucht, komme jetzt aber nicht so recht weiter... Ich hoffe, ich habe mein Problem einigermaßen verständlich beschrieben. Vielen Dank schon mal im Voraus an die Excelperten....!!
Sub Pruefen_ob_Datei_vorhanden()
Dim Dateiname, Linie, Datum, Range As String
Datum = ActiveWorkbook.Worksheets("PD`s").Range("A37")
Linie = ActiveWorkbook.Worksheets("PD`s").Range("A39")
Dateiname = Datum
SearchSubFolders = True
If Dir("H:\MDE geprüft") & Dateiname = "" Then
Application.ScreenUpdating = False
Sheets("PD`s").Select
ActiveWindow.SmallScroll Down:=-18
Range("B2:AF30").Select
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Selection.Copy
Application.CutCopyMode = True
ChDir "H:\MDE geprüft" & Dateiname
Else
MsgBox ("Datei ist schon vorhanden!") & vbOKOnly
Application.ScreenUpdating = True
End If
End Sub
Anzeige