AW: Daten aus Bereich auflisten
14.01.2010 09:16:10
lisa
Hallo Luschi
ich möchte gern alles um zwei Spalten nach rechts verschieben.
Deinen VBA- Code habe ich ersteinmal um eine Spalte geä. aber es wird die Artikelnummer nun in Spalte B nicht mehr mitgenommen. Was habe ich falsch gemacht?
Dazu habe ich deinen VBA wie folgt geä.
Sub MachMal_01()
Dim wb As Workbook, ws As Worksheet, _
rg1 As Range, rg2 As Range, rg3 As Range
Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, n5 As Long, _
v1, v2, v3
Set wb = ThisWorkbook
Set ws = ActiveSheet
Set rg1 = ws.Range("B4")
Set rg2 = ws.Range("J4")
'letzte Zeile in Spalte A
n1 = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
'letzte Zeile in Spalte I
n2 = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
'Bereich I:M von Zeile 4 bis n2 leeren
ws.Range("J4:n" & n2).ClearContents
'Laufvariable für Spalten I bis M
n3 = 3
'alle Zellen von A4 bis An1 durchlaufen
For Each rg3 In ws.Range("B4:B" & n1)
If "" rg3 Then
'Zellen in Spalte C bis G durchlaufen
For n4 = 4 To 8
If "" ws.Cells(rg3.Row, n4) Then
n3 = n3 + 1
ws.Range("J" & n3).Value = rg3.Value
'ws.Cells(n3, "I").Value = rg3.Value
ws.Cells(n3, "J").Value = ws.Cells(rg3.Row, n4)
ws.Cells(n3, "N").Value = ws.Cells(3, n4).Value 'Zeile zum Datum
End If
Next n4
End If
Next rg3
Set rg3 = Nothing
Set rg2 = Nothing
Set rg1 = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub
Du hast dir große Mühe gegeben, ersteinmal herzlichen Dank!
Vielleicht kannst du ja nocheinmal draufschauen
Lieben Gruß Lisa