Spalten kopieren
14.06.2009 17:00:54
edie
im nachfolgenden Code werden Daten aus der Tabelle "Source" nach "Target" ab der Spalte C übertragen, wobei die Spalten können auch Lücken haben.
Leider dürfen resp. können die leeren Spalten in "Target" nicht gelöscht werden. Zum Beispiel,
wenn man erst den ganze Bereich kopieren würde und zum Schluss die leeren Spalten löscht.
In Abhängigkeit des Inhaltes der Zeile 1 in "Source" sollen die nächst leere Spalte in "Target" gefüllt werden.
Für die Spalte C funktioniert das:
Sub Spalte_C() 'C
Dim wksS As Worksheet
Dim wksT As Worksheet
Dim iRow As Integer, iRowL As Integer
Dim iCol As Integer
Set wksS = Worksheets("Source")
Set wksT = Worksheets("Target")
iRowL = wksS.Cells(Rows.Count, 1).End(xlUp).Row
iCol = 1
For iRow = 1 To iRowL
If Not IsEmpty(wksS.Cells(1, iCol + 2)) Then
Range(wksT.Cells(iRow, iCol + 2), wksT.Cells(iRow, iCol + 2)).Value = _
Range(wksS.Cells(iRow, iCol + 2), wksS.Cells(iRow, iCol + 2)).Value
End If
Next iRow
End Sub
Für die Spalte D wie Folgt:
Sub Spalte_D() 'D
Dim wksS As Worksheet
Dim wksT As Worksheet
Dim iRow As Integer, iRowL As Integer
Dim iCol As Integer
Set wksS = Worksheets("Source")
Set wksT = Worksheets("Target")
iRowL = wksS.Cells(Rows.Count, 1).End(xlUp).Row
iCol = 1
For iRow = 1 To iRowL
If Not IsEmpty(wksS.Cells(1, iCol + 3)) Then
If IsEmpty(wksT.Cells(iRow, iCol + 2)) Then
Range(wksT.Cells(iRow, iCol + 2), wksT.Cells(iRow, iCol + 2)).Value = _
Range(wksS.Cells(iRow, iCol + 3), wksS.Cells(iRow, iCol + 3)).Value
ElseIf Not IsEmpty(wksT.Cells(iRow, iCol + 2)) Then
Range(wksT.Cells(iRow, iCol + 3), wksT.Cells(iRow, iCol + 3)).Value = _
Range(wksS.Cells(iRow, iCol + 3), wksS.Cells(iRow, iCol + 3)).Value
End If
End If
Next iRow
End Sub
Habe noch mindestens 10 weitere Spalten, und so langsam wird es kompliziert.
Gibt es einen anderen Weg bzw. Beispiel-Code den man anpassen könnte?
Vorab vielen Dank.
Grüße