Sub New_extract_columns222()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Obst")
Dim ws_copy1 As Workbook
Dim ws_copy As Worksheet
Set ws_copy1 = ThisWorkbook.Application.Workbooks.Open("C:\Users\Michael Kling\Documents\Money &Beruf\Skills und Wissen\Excel\VBA\Nachhilfe Manuel\LH\Beispieldatei2.xlsx")
Set ws_copy = ws_copy1.Worksheets("Obst_copy")
Dim iRunner As Integer
Dim sSpalte As String
Dim jRunner As Integer
Dim jSpalte As String
Dim END_ROW As Long
Dim LAST_ROW As Long
Dim copy_area As Range
Dim rlast As Integer
Dim rlast2 As Integer
Dim rlast_clear As Integer
Dim clear_range As Range
rlast = ws_copy.UsedRange.SpecialCells(xlCellTypeLastCell).Row
rlast2 = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
rlast_clear = ws.Cells(300000, 1).End(xlUp).Offset(1, 0).Row
Set clear_range = ws.Range(ws.Cells(rlast_clear + 2, 1), ws.Cells(Cells(rlast_clear).End(xlDown).Row, 500))
clear_range.ClearContents
For iRunner = 1 To 3
sSpalte = ws.Cells(1, iRunner).Name.Name
Debug.Print (sSpalte)
For jRunner = 1 To 3
jSpalte = ws_copy.Cells(1, jRunner).Name.Name
Debug.Print (jSpalte)
Set copy_area = ws_copy.Range(ws_copy.Cells(2, jRunner), ws_copy.Cells(rlast, jRunner))
If jSpalte = sSpalte Then
copy_area.Copy (ws.Cells(rlast2 + 1, iRunner))
End If
Next
Next
End Sub