Daten übertragen mit Makro 2
01.10.2003 22:15:48
dansmo
Leider hat ChrisL, der mir bisher geholfen hat keine Zeit mehr.
Ich hoffe mir kann jemand anderes weiterhelfen.
Die bisherieg Dikussion befand sich hier:
http://xlforum.herber.de/messages/311952.html
Ich fasse meinen Wunsch hier noch mal kurz zusammen:
Mit einem Makro möchte ich mir das ziemlich lästige Copy&Paste ersparen.
Ich exportiere mit einem Programm Daten in .csv Reports. Diese Daten sollen
in eine Zieldatei eingespeist werden. Pro Zieldatei gibt es immer 2 .csv Dateien.
Im Prinzip wäre das Makro auch schon fertig gewesen. Das Problem ist nun,
dass sich auf die eingefügten Daten Formeln in einem anderen Blatt der
Zieldatei beziehen und dadurch in jeder Zelle #Bezug! steht.
Das bisherige Makro bei dem Der Datenimport super funktioniert sieht
so aus (nochmals vielen Dank an ChrisL!):
Option Explicit
Sub Import()
Dim i As Integer
Dim fFile1 As Variant, fFile2 As Variant, neuFile As Variant
Dim Datei1 As Workbook, Datei2 As Workbook, neuDatei As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
On Error GoTo ErrorHandler
Range("F13") = "Bitte warten..."
ThisWorkbook.Saved = True
Application.ScreenUpdating = False
' Datei 1 öffnen
fFile1 = Application.GetOpenFilename("CSV-Report (*.csv), *.csv")
If fFile1 = False Then
If Workbooks.Count = 1 Then
Application.Quit
Exit Sub
Else
ThisWorkbook.Close
Exit Sub
End If
End If
Workbooks.Open FileName:=fFile1
Set Datei1 = ActiveWorkbook
Set WS1 = Datei1.Worksheets(1)
WS1.Name = "Pattern_short"
' Datei 2 öffnen
fFile2 = Application.GetOpenFilename("CSV-Report (*.csv), *.csv")
If fFile2 = False Then
MsgBox "Der Vorgang wird vorzeitig abgebrochen."
If Workbooks.Count = 2 Then
Application.Quit
Exit Sub
Else
Datei1.Close , False
ThisWorkbook.Close
Exit Sub
End If
End If
Workbooks.Open FileName:=fFile2
Set Datei2 = ActiveWorkbook
Set WS2 = Datei2.Worksheets(1)
WS2.Name = "Pattern_long"
' Zieldatei öffnen
Application.Dialogs(xlDialogOpen).Show
If ActiveWorkbook.Name = Datei2.Name Then
MsgBox "Der Vorgang wird vorzeitig abgebrochen."
If Workbooks.Count = 3 Then
Application.Quit
Exit Sub
Else
Datei1.Close , False
Datei2.Close , False
ThisWorkbook.Close
Exit Sub
End If
End If
Set neuDatei = ActiveWorkbook
' Bestehende Blätter löschen
Application.DisplayAlerts = False
On Error Resume Next
neuDatei.Worksheets("Pattern_short").Delete
neuDatei.Worksheets("Pattern_long").Delete
On Error GoTo ErrorHandler
Application.DisplayAlerts = True
' Blätter in die neue Datei kopieren
Datei2.Worksheets(1).Copy Before:=neuDatei.Sheets(1)
Datei1.Worksheets(1).Copy Before:=neuDatei.Sheets(1)
' Datei1 und 2 schliessen
Application.DisplayAlerts = False
Datei1.Close , False
Datei2.Close , False
Application.DisplayAlerts = True
' neue Datei speichern
neuDatei.Save
' Vorlagedatei schliessen
ThisWorkbook.Saved = True
ThisWorkbook.Close
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox "Es ist ein unvorhergesehener Fehler aufgetreten. Bitte wiederholen Sie den Vorgang."
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Vielen Dank für eure Hilfe,
Daniel