Hallo,

ich habe folgende Problematik/Fragestellung:

Ich möchte durch einen Code die Werte von Spalten in Abhängigkeit von ihrem Titel von einer Arbeitsmappe in eine andere kopieren.

Dabei beziehe ich mich auf die "UsedRange". Folgende mögliche Problematik sehe ich allerdings dabei:

Sagen wir ich habe in Spalte A, B,C jeweils Daten die bis in die Zeile 4 oder 5 gehen. Dann wird der Code die kopierten Daten ab Zeile 5 einfügen. Alles soweit gut. Würde allerdings der User aus Versehen in Zelle C8 eine Zahl eintragen würden die Datein ja dadurch ab Zeile 9 eingefügt werden weil sich die UsedRange geändert hat.

Deshalb möchte ich immer die Daten unter meiner eigentlichen Tabelle löschen, weiss aber nicht wie ich das automatisieren kann bzw. wie VBA erkennen kann, dass C8 eigentlich nicht zur "UsedRange" gehört.

Hier der Code:

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)) 'Problem: Wenn die Spalte A unten mehr als 2 Leerzellen hat Als Lösung: Vielleicht doch als Tabelle formatieren / oder Spalte nehmen die bisher zu 100% voll war
    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