Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Daten übertragen mit Makro 2

    Betrifft: Daten übertragen mit Makro 2 von: dansmo
    Geschrieben am: 01.10.2003 22:15:48

    Hallo Zusammen!

    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
      


    Betrifft: AW: Daten übertragen mit Makro 2 von: ChrisL
    Geschrieben am: 03.10.2003 17:07:53

    Hi Daniel

    Konnte sich wohl niemand für das Problem begeistern ;-)

    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
    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
    
    ' 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
    
    ' 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
    
    ' Blätter in die neue Datei kopieren
    Datei1.Worksheets(1).Cells.Copy neuDatei.Worksheets("Pattern_short").Range("A1")
    Datei2.Worksheets(1).Cells.Copy neuDatei.Worksheets("Pattern_long").Range("A1")
    
    ' 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
    
    ' Fehlerbehandlung
    ErrorHandler:
    MsgBox "Es ist ein unvorhergesehener Fehler aufgetreten. Bitte wiederholen Sie den Vorgang."
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub
    



    Gruss
    Chris


      


    Betrifft: AW: Daten übertragen mit Makro 2 von: dansmo
    Geschrieben am: 06.10.2003 08:38:33

    Hi Chris!

    Danke! Das ist so wie ich es mir gedacht habe!
    Sehr gute Arbeit!!!

    Beste Grüße,
    Daniel