Abfrage in VBA
24.02.2006 09:48:58
maze
kann mir bitte jemand mit einer Abfrage in diesem Makro helfen.
Wenn nicht alle Zellen Daten enthalten, sollen die Daten nicht in die Datenbank.
Eine Abfrage zum weitermachen mit Ja oder Abbrechen wäre sinnvoll, bevor Application.Run "Einspielen" am Ende dieses Makro startet.
Hilfe wäre sehr nett
Gruß
Matthias
Sub AntwortLaden()
Application.ScreenUpdating = False
Sheets("Vorbereitung").Activate
Pfad = "K:\Kostentraeger\Mail"
Pfadantwort = Pfad
ChDir Pfadantwort
AntwortDatei = Application.GetOpenFilename("Excel-Dateien (*.xls), *.xls")
If AntwortDatei <> False Then
Range("A1:H20").Select
Application.CutCopyMode = False
Selection.Clear
Workbooks.Open AntwortDatei
FensterAntwortDatei = ActiveWindow.Caption
Sheets("Meldung").Select
Sheets("Meldung").Activate
Range("G7,I7").Select
Selection.Copy
Windows("Auftragsmeldungen.xls").Activate
Sheets("Vorbereitung").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows(FensterAntwortDatei).Activate
Range("g8").Select
Selection.Copy
Windows("Auftragsmeldungen.xls").Activate
Sheets("Vorbereitung").Select
Range("c1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows(FensterAntwortDatei).Activate
Range("i8").Select
Selection.Copy
Windows("Auftragsmeldungen.xls").Activate
Sheets("Vorbereitung").Select
Range("d1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows(FensterAntwortDatei).Activate
Range("c34").Select
Selection.Copy
Windows("Auftragsmeldungen.xls").Activate
Sheets("Vorbereitung").Select
Range("e1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows(FensterAntwortDatei).Activate
Range("c35").Select
Selection.Copy
Windows("Auftragsmeldungen.xls").Activate
Sheets("Vorbereitung").Select
Range("f1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows(FensterAntwortDatei).Activate
Range("c36").Select
Selection.Copy
Windows("Auftragsmeldungen.xls").Activate
Sheets("Vorbereitung").Select
Range("g1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows(FensterAntwortDatei).Activate
ActiveWindow.Close
End If
Application.ScreenUpdating = True
Application.Run "Einspielen"
End Sub
Anzeige