Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1620to1624
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten zwischen mehreren Excel-Dateien kopieren

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
Anzeige
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
Anzeige
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

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige