Hallo Ch79

Ich hab das jetzt nicht getestet. Die Funktion DateiÖffnen ist bei mir so schon Jahre lang im Einsatz
und macht mir keine Probleme. Sie öffnet eine übergebene Datei oder übernimmt sie, wenn sie schon
geöffnet ist.

Die Sub ist wie gesagt nicht getestet, da mir die Originaldateien fehlen.

Exceldatei 2
-hat in Spalte B verbundene Zelle mit C Kalenderwochen mit der Abkürzung KW1, KW2, KW3.... -KW52
-es soll die entsprechende KW (gem. Excel 1) in der Spalte suchen und auf der nächsten freien Zeile die Daten aus L66:U66 einfügen
-kann es jeweils wen nur noch 1 freie Zeile zwischen den Kalenderwochen sind eine weitere freie Zeile einfügen

Ich nehme an:
- in Spalte B stehen die Kalenderwochen (was das Zelle mit C Kalenderwochen heißt, konnte ich mir nicht erklären)
- unterhalb der Zelle, in der z.B. KW44 steht, sind noch leere Zellen, in die dann die Daten kommen

Somit bitte mal selber testen und ggf. anpassen.
ralf_b hat schon recht. Bitte einfach die einzelnen Aufgaben lösen, wie Dateien öffnen, Werten in Spalten
suchen (Vergleich als Tabellenfunktion gibt es), Daten kopieren. Dann diese Lösungen kombinieren. 
Wenn dann noch Fragen auftreten, diesen Code hier mitposten und dann können wir dir die Fehler erklären.

"Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. Lehre einen Mann zu fischen und du ernährst ihn für sein Leben"
Konfuzius, Chinesischer Pilosoph

Ich versuche lieber das angeln zu lehren (das programmieren an sich), statt täglich Fische zu verteilen.

Danke fürs Verständnis

Gruß Der TestGast

--- Makro ---

Option Explicit


Sub DatenKopieren()
    Dim intKW As Integer
    Dim strKW As String
    
    Dim varZeile As Variant
    
    Dim wsQuelle As Worksheet
    Set wsQuelle = ActiveSheet              'Muss ja das aktuelle Blatt sein, da mit Button gestartet
    
    Dim strZielDatei As String
    Dim strZielTabelle As String
    strZielDatei = "c:\temp\excel2.xlsx"    'Hier bitte Anpassen oder eigene Abfrage erstellen
    strZielTabelle = "Tabelle1"             'Hier bitte Anpassen oder eigene Abfrage erstellen
    
    Dim lngZielZeile As Long
    
    Dim wbZiel As Workbook
    Dim wsZiel As Worksheet
    
    'Zieldatei öffnen, oder wenn geöffnet übernehmen
    Set wbZiel = DateiÖffnen(strDateiname:=strZielDatei, UpdateLinks:=True, ReadOnly:=False)
    If wbZiel Is Nothing Then
        MsgBox "Datei nicht gefunden!", vbCritical + vbOKOnly, "Datei nicht gefunden"
        Exit Sub
    End If
    Set wsZiel = wbZiel.Worksheets(strZielTabelle)
    
    'Kalenderwoche aus Excel1 auslesen
    intKW = wsQuelle.Range("B41").Value
    strKW = "KW" & intKW
    
    'KWxx in Zieldatei suchen
    varZeile = Application.Match(strKW, wsZiel.Columns(3), 0)
    If VarType(varZeile) <> vbError Then
        lngZielZeile = Val(VarType)
    End If
    
    'nächste freie Zelle suchen (in Spalte 2)
    Do While wsZiel.Cells(lngZielZeile, 2) <> ""
        lngZielZeile = lngZielZeile + 1
    Loop
    
    'Daten kopieren
    wsQuelle.Range("L66:U66").Copy Destination:=wsZiel.Cells(lngZielZeile, 2)
    
    'Aufräumen
    Set wbZiel = Nothing
    Set wsZiel = Nothing
    Set wsQuelle = Nothing
End Sub


Private Function DateiÖffnen( _
            ByVal strDateiname As String, _
            ByVal UpdateLinks As Boolean, _
            ByVal ReadOnly As Boolean) As Workbook
            
    Dim WB As Workbook
    Dim Pos As Long
    Dim DateiName As String
    
    Pos = InStrRev(strDateiname, "\", , vbTextCompare)
    If Pos = 0 Then Exit Function
    
    DateiName = Mid(strDateiname, Pos + 1)
    
    For Each WB In Application.Workbooks
        If WB.Name = DateiName Then
            Set DateiÖffnen = WB
            Exit Function
        End If
    Next WB
    
    On Error Resume Next
    Set DateiÖffnen = Workbooks.Open(strDateiname, UpdateLinks:=UpdateLinks, ReadOnly:=ReadOnly)
    On Error GoTo 0
End Function