Hallo Zusammen,

ich versuche vergebens Daten via Makro in eine neue Liste zu kopieren.

Passieren soll folgendes:

via Auswahlfenster Datei auswählen welche geöffnet werden soll ( Funktioniert schon )

Dann immer gleichbleibende Zeilen/Spalten vom gerade geöffneten File in das Dokufile kopieren.

Folgendes habe ich dabei schon versucht :

Sub OeffnenDialog_mit_Pfadvorgabe()

'** Anzeige des Öffnen-Dialogfensters mit voreingestelltem Pfad

 

'** Dimensionierung der Variablen

Dim wb As Workbook

'Dim ws As Worksheet

Dim lngZ As Long

Dim strFileName

Dim strFilter As String


 

'** Dateifilter definieren

strFilter = "Excel-Dateien(*.xl*), *.xl*"

 

'** Laufwerk und Pfad definieren, welcher geöffnet werden soll

ChDrive "H"

ChDir "H:\Arbeit\Projekte\"

 

'** Den im Dialogfeld gewählten Namen auslesen

strFileName = Application.GetOpenFilename(strFilter)

 

'** Prüfen, ob eine gültige Datei ausgewählt wurde

If strFileName = False Then Exit Sub

 

'** Gewählte Datei öffnen

Set wb = Workbooks.Open(strFileName)

'
'** Daten übertragen
'

    Windows(Datei).Activate                                           ------ hier Datei durch den Dateinamen der ausgewählten Datei ersetzten? 
    Range("A4").Select
    Selection.Copy
    Windows("1DP-Checkliste.xlsm").Activate
    Range("C12:V12").Select
    ActiveSheet.Paste
    Windows(Datei).Activate
    Range("C4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("1DP-Checkliste.xlsm").Activate
    Range("W12:AF12").Select
    ActiveSheet.Paste
    Windows(Datei).Activate
    Range("D4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("1DP-Checkliste.xlsm").Activate
    Range("AQ12:CD12").Select
    ActiveSheet.Paste
    Windows(Datei).Activate
    Range("J4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("1DP-Checkliste.xlsm").Activate
    Range("CT12:DC12").Select
    ActiveSheet.Paste
    Windows(Datei).Activate
    Range("I4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("1DP-Checkliste.xlsm").Activate
    Range("DD12:DM12").Select
    ActiveSheet.Paste
    
End Sub