Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1080to1084
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Code optimieren beim Spalten kopieren

Code optimieren beim Spalten kopieren
11.06.2009 22:42:07
edie
Hallo zusammen,
habe mir ein Makro zusammen geschustert, ein Excel-Profi wird schon mal lachen, aber es
funktioniert. Dabei werden Spalten (beinhalten Lücken) in Abhängigkeit der Zeile 1 kopiert.
Und nun, würde ich gerne das Makro optimieren, so dass die Spalten nacheinander im Blatt
"Target" kopiert werden. Beispiel, wenn die Zelle "C1" leer ist dann wird die Spalte C nicht
kopiert dabei soll die nächste Spalte D in die Spalte C kopiert werden, d.h. keine leere Spalten
im Blatt "Target".

Sub Test()
Dim iRow As Integer, iRowL As Integer, iRowT As Integer
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 1 To iRowL
If Not IsEmpty(Cells(1, 1)) Then
With Worksheets("Target")
.Range(.Cells(iRow, 1), .Cells(iRow, 1)).Value = _
Range(Cells(iRow, 1), Cells(iRow, 1)).Value
End With
End If
If Not IsEmpty(Cells(1, 2)) Then
With Worksheets("Target")
.Range(.Cells(iRow, 2), .Cells(iRow, 2)).Value = _
Range(Cells(iRow, 2), Cells(iRow, 2)).Value
End With
End If
If Not IsEmpty(Cells(1, 3)) Then
With Worksheets("Target")
.Range(.Cells(iRow, 3), .Cells(iRow, 3)).Value = _
Range(Cells(iRow, 3), Cells(iRow, 3)).Value
End With
End If
If Not IsEmpty(Cells(1, 4)) Then
With Worksheets("Target")
.Range(.Cells(iRow, 4), .Cells(iRow, 4)).Value = _
Range(Cells(iRow, 4), Cells(iRow, 4)).Value
End With
End If
Next iRow
End Sub


Kann mir jemand dabei helfen? Was sollte verändert werden?
Vorab vielen Dank.
Grüße

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code optimieren beim Spalten kopieren
11.06.2009 23:26:02
Beate
Hallo,
Sub Makro2()
    Dim i As Long ' Spaltenzähler
    With Sheets("Target")
        'Zunächst werden Spalten A:D komplett ins Zielblatt kopiert
        'Tabellenname des Ausgangsblatts anpassen
        Sheets("Tabelle1").Columns("A:D").Copy .Columns("A:D")
        'Nun werden Spalten D bis A rückwärts durchlaufen und
        'gelöscht, falls sie in Zeile1 leer sind.
        For i = 4 To 1 Step -1
            If .Cells(1, i).Value = "" Then .Columns(i).Delete
        Next
    End With
End Sub

Gruß,
Beate
Anzeige
AW: Code optimieren beim Spalten kopieren
11.06.2009 23:37:22
edie
Hallo Beate,
es funktioniert, wunderbar, herzlichen Dank. Schönen Abend noch.
Vielen Dank
Grüße

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige