Kopierte Daten werden nicht eingefügt

Hallo, ich schon wieder....
Ich muss aus mehreren Dateien im ersten Arbeitsblatt Daten kopieren (ohne Haeder) und in eine Datei im Arbeitsblatt BÜ-Tool einfügen. Dafür habe ich folgenden Code geschrieben. Leider kopiert der (warum auch immer) die Daten nicht in mein Worksheet. Findet jemand den Fehler? Ganz lieben Dank für die Hilfe.
Sub BÜTool_Zusammenfügen_Klicken()
Dim arrDateien As Variant
Dim wbQuelle As Workbook
Dim LetzteZeile As Long
Dim cntDatei As Long
Dim rngQuelle As Range

'Screenupdating und Popups deaktivieren:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Datei auswählen
arrDateien = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.xls*), *.xls*", MultiSelect:=True)
'ist eine Datei ausgewählt?
If IsArray(arrDateien) Then

'Schleife über ausgewählten Dateien
For cntDatei = 1 To UBound(arrDateien)
LetzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

'Mappe öffnen
Set wbQuelle = Workbooks.Open(Filename:=arrDateien(cntDatei))

'Daten Range setzen:

Set rngQuelle = wbQuelle.Worksheets(1).Range("B2").CurrentRegion

'Daten kopieren und einfügen

Intersect(rngQuelle, rngQuelle.Offset(1, 0)).Copy

ThisWorkbook.Worksheets("BÜ-Tool").Range("A" & LetzteZeile + 1).PasteSpecial

'Mappe schließen

wbQuelle.Close SaveChanges:=False

Next cntDatei

End If
'Screenupdating und Popups aktivieren:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Friederich,
Es fehlt nach dem PasteSpecial einen "xlPasteValues". PasteSpecials scheint keine "Default-Value" zu kennen.
Ansonsten ist in deinem Code per se kein Fehler direkt zu erkennen.
Wie Rudi es bereit entdeckt hat, ist es verwirrend die letzte Zeile über "Worksheets(1)" zu ermitteln, un diese in "Worksheets("BÜ-Tool") " zu verwenden, aber muss nicht ein Fehler sein.
Ich habe zusätzlich einen "Petzer" dazwischen reingebracht: es wird im Direktfenster pro Schleife die entsprechende Werte herausgegeben.
Ansonsten könntest/solltest Du im Schritt Modus laufen lassen. Application.GetOpenFilename schient aber diese Schritt-Modus auszusetzen, einfach direkt danach einen Breakpoint setzen.

Sub BÜTool_Zusammenfügen_Klicken()
Dim Dat
Dim rgQ As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each Dat In Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.xls*), *.xls*", MultiSelect:=True)
        With Workbooks.Open(Dat)
            Set rgQ = .Worksheets(1).Range("B2").CurrentRegion
            Set rgQ = Intersect(rgQ, rgQ.Offset(1, 0))
        Debug.Print Dat, .Worksheets(1).Name, rgQ.Rows.Count, rgQ.Columns.Count
            rgQ.Copy 'ohne die erste Zeile
            ThisWorkbook.Worksheets("BÜ-Tool").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            .Close SaveChanges:=False
        End With
    Next Dat
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

VG
Yal

Application.Goto ThisWorkbook.Worksheets("BÜ-Tool").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) ThisWorkbook.Worksheets("BÜ-Tool").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

Beliebteste Forumthreads (12 Monate)

Kopierte Daten werden nicht eingefügt

20 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread