Listen nebeneinander, untereinander kopieren

Hey,
ich bin jetzt seit längerer Zeit an meinem Problem und konnte im Internet keine gute Lösung finden ohne alles Händisch zu machen.
Ich habe eine Datei erstellt, in der Projekte eingetragen werden können, bei Drücken des Buttons, werden alle Projekte um einen Bereich nach rechts verschoben. Die Tabelle hat eine Kapazität von 63 Bereichen und das 5 mal untereinander.
Userbild

Im Nachhinein war die Lösung vielleicht nicht optimal, aber damit muss ich jetzt leben.
Nun möchte ich, dass ich die Einträge der Bereiche, also hier A32:G41, dann I32:O41 etc untereinander stehen habe in einer Liste. Vielleicht stehe ich auch nur heftig auf dem Schlauch und sehe eine Offensichtliche Lösung nicht.
Ich denke INDIREKT Oder INDEX könnte weiterhelfen, aber bisher hat es nicht so ganz funktioniert.
Wäre super, wenn ihr mir helfen könntet.

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Patrick,
per Formel dürfte das sehr kompliziert werden, da hier ja immer nur 10 Zeilen aus einem größeren Block ausgelesen werden sollen.
Ich denke, dass du da per Makro schneller zu einer Lösung kommst.
Nachfolgend ein Makro, das du bezüglich der Zeilenzahlen ggf. noch anpassen muss.
Gruß
Franz

Sub IncomeBlocks_in_eine_Spalte()
Dim wksQ As Worksheet, wksZ As Worksheet
Dim ZeileQ As Long, SpalteQ As Long
Dim ZeileZ As Long, ZeileZ1 As Long
Dim ZeileQL As Long, SpalteQL As Long
Dim AnzZeilen As Long, AnzSpalten As Long
Set wksQ = ActiveWorkbook.Sheets("PROJECTS")
Set wksZ = ActiveWorkbook.Sheets("Income_List") 'Name Zieltabelle anpassen!!
Application.ScreenUpdating = False
With wksZ
ZeileZ1 = 2 'Startzeile für das Einfügen der Daten im Zielblatt - ggf. anpassen
ZeileZ = .UsedRange.Row + .UsedRange.Rows.Count - 1
If ZeileZ >= ZeileZ1 Then
'Altdaten löschen
.Range(.Rows(ZeileZ1), .Rows(ZeileZ)).Clear
End If
ZeileZ = ZeileZ1
End With
With wksQ
ZeileQL = .UsedRange.Row + .UsedRange.Rows.Count - 1
If ZeileQL >= 28 Then '28 = 1. Zeile des 1. Projektes - ggf anpassen
AnzZeilen = 27 'Anzahl Zeilen pro Projekt - ggf. anpassen!!
AnzSpalten = 8 'Anzahl Spalten pro Projekt - ggf. anpassen!!
SpalteQL = .UsedRange.Column + .UsedRange.Columns.Count - 1
For ZeileQ = 28 To ZeileQL Step AnzZeilen
For SpalteQ = 1 To SpalteQL Step AnzSpalten
.Range(.Cells(ZeileQ + 4, SpalteQ), .Cells(ZeileQ + 4 + 9, SpalteQ + AnzSpalten - 2)). _
Copy
With wksZ
.Cells(ZeileZ, 1).PasteSpecial Paste:=xlPasteFormats
.Cells(ZeileZ, 1).PasteSpecial Paste:=xlPasteValues
ZeileZ = ZeileZ + 10
End With
Next
Next
Application.CutCopyMode = False
wksZ.Activate
Cells(ZeileZ1, 1).Select
End If
End With
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Listen nebeneinander, untereinander kopieren

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread