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
|