Daten zwischen mehreren Excel-Dateien kopieren

Forumthread: Daten zwischen mehreren Excel-Dateien kopieren

21.04.2018 14:56:03

Specht

Hallo zusammen,
ich möchte mittels VBA Daten von einem anderen Excel-Dokument in das aktuelle kopieren. Das funktioniert bereits, allerdings dauert dies sehr lange (bei 100 zu kopierenden Zeilen mit je 4 Zellen).
Habt ihr eventuell Verbesserungsvorschläge für mich?
Hier wäre mein aktueller Code:


'Datei öffnen
Workbooks.Open Filename:=strPath + "\" + strCurrentFile, ReadOnly:=True
'Anzahl der Zeilen in anderer Datei herausfinden
intRows = ActiveSheet.Cells(1000, 4).End(xlUp).Row
'Relevante Daten kopieren und wieder einfügen
ii = 14
For i = 1 To intRows
If ActiveWorkbook.Worksheets("Tabelle1").Cells(i, 4).Value = "Produkt" Then
ThisWorkbook.Worksheets("Tabelle1").Cells(ii, 1).Value = ActiveWorkbook.Worksheets(" _
Tabelle1").Cells(i, 1).Value
ThisWorkbook.Worksheets("Tabelle1").Cells(ii, 2).Value = ActiveWorkbook.Worksheets(" _
Tabelle1").Cells(i, 13).Value
ThisWorkbook.Worksheets("Tabelle1").Cells(ii, 3).Value = ActiveWorkbook.Worksheets(" _
Tabelle1").Cells(i, 17).Value
ThisWorkbook.Worksheets("Tabelle1").Cells(ii, 4).Value = ActiveWorkbook.Worksheets(" _
Tabelle1").Cells(i, 18).Value
ii = ii + 1
End If
Next
'Datei wieder schließen
ActiveWorkbook.Close

Schon einmal vielen Dank für euere Hilfe!
Viele Grüße
Jakob

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten zwischen mehreren Excel-Dateien kopieren

21.04.2018 15:32:47

Hajo_Zi
AW: Daten zwischen mehreren Excel-Dateien kopieren

21.04.2018 18:52:29

Nepumuk
Korrektur

22.04.2018 09:07:24

Nepumuk

AW: Daten zwischen mehreren Excel-Dateien kopieren

21.04.2018 15:32:47

Hajo_Zi

Hallo Jakob,
prüfe doch mal ob STRG+Ende mit den Ende Deiner Tabelle übereinstimmt?
Letzte Zeile nach Tabelle bist Strg+Ende+1 Zeile löschen und speichern.

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.

AW: Daten zwischen mehreren Excel-Dateien kopieren

21.04.2018 18:52:29

Nepumuk

Hallo Jakob,
teste mal:

    Dim objWorkbook As Workbook
    Dim lngRows As Long, i As Long, ii As Long
    Dim avntInputValues As Variant, avntOutputValues() As Variant

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    'Datei öffnen
    Set objWorkbook = Workbooks.Open(Filename:=strPath & "\" & strCurrentFile, ReadOnly:=True)

    With objWorkbook.Worksheets("Tabelle1")

        'Anzahl der Zeilen in anderer Datei herausfinden
        lngRows = .Cells(1000, 4).End(xlUp).Row
        avntInputValues = .Range(.Cells(1, 1), .Cells(lngRows, 18)).Values

    End With

    'Datei wieder schließen
    Call objWorkbook.Close(SaveChanges:=False)

    For i = 1 To lngRows

        If avntInputValues(i, 4) = "Produkt" Then

            'Ausgabearray erweitern
            Redim Preserve avntOutputValues(ii, 3)

            'Relevante Daten von einam Array in das andere einfügen
            avntOutputValues(ii, 0) = avntInputValues(i, 1)
            avntOutputValues(ii, 1) = avntInputValues(i, 13)
            avntOutputValues(ii, 2) = avntInputValues(i, 17)
            avntOutputValues(ii, 3) = avntInputValues(i, 18)

            ii = ii + 1

        End If
    Next

    'Array ausgeben
    ThisWorkbook.Worksheets("Tabelle1").Cells(14, 1).Resize(ii - 1, 4).Value = avntOutputValues

    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Gruß
Nepumuk

Korrektur

22.04.2018 09:07:24

Nepumuk

Hallo Jakob,
mir fällt gerade ein, dass ich einen Fehler in der Ausgabezeile habe. Die muss so lauten:

ThisWorkbook.Worksheets("Tabelle1").Cells(14, 1).Resize(ii, 4).Value = avntOutputValues

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Daten zwischen mehreren Excel-Dateien kopieren

Forumthread: Daten zwischen mehreren Excel-Dateien kopieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread