Spalten untereinander kopieren

Hallo liebe Community,
ich habe ein Problem bei dem ich nicht weiter komme.
Ich habe ca. 80 Sheets (Sheet 1,....80) in dem jeweils die Zeilen 1 bis 200 in Spalte A gleich befüllt sind mit Kriteriennamen.
In den Spalten B bis z.B. XXX stehen im Kopf der Spalte ein Datum mit einem jeweiligen Wert für das Kriterium pro Tag. Diese Struktur ist jedoch ungeeignet wenn ich mit einer Pivottabelle mit den Daten arbeiten möchte.
Ausgangs- und Zielsituation:
Userbild

Kann mir jemand sagen, wie ich die Datenstruktur umbauen kann um auf die Form in der Zielsituation zu gelangen?
Meine Idee war es, dass ich auswählen kann aus welchen der Sheets, die alle die gleich Datenstruktur besitzen, ich die Werte kopieren möchte und die Werte in ein "Azuswertungssheet" kopiert werden. Über die Daten dieses Sheets "Auswertungssheets" ist eine Pivottabelle/tabel gelegt welches nach abgeschlossenen Kopierens der Daten die Pivottabelle aktuallisiert.
Die Anzahl der Spalten kann ggf. über 1000 betragen und hat keinen Maximalwert.
Das Problem ist zwar nicht neu und ich konnte viele Beiträge dazu finden, jedoch ist es mir nicht gelungen einen der Vorschläge auf mein Problem zu adaptieren. Es wäre klasse wenn mir jemand weiterhelfen könnte!
Viele Grüße
sav

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

hier eine VBA-Variante

17.11.2015 11:21:45

Matthias

VBA Variante

17.11.2015 11:29:17

Tino

AW: VBA Variante

17.11.2015 14:02:26

Sav

AW: VBA Variante

17.11.2015 14:07:07

Tino

AW: VBA Variante

17.11.2015 17:23:10

Sav

AW: VBA Variante

17.11.2015 18:24:24

Tino

AW: VBA Variante

18.11.2015 22:17:04

Sav

AW: VBA Variante

20.11.2015 08:57:42

Sav

AW: VBA Variante

20.11.2015 10:27:06

Tino

Hallo,
hier ein Beispiel mit VBA, Ausgabe erfolgt in einer neuen Tabelle
Für den Datenbereich habe ich mich an deinem Bild orientiert.
Ab A2 bis zur letzten in Zelle in Spalte A und bis zu letzten in Zelle in Zeile 2.
Evtl. müsstest Du die Tabelle und den Zellbereich anpassen!

Sub Beispiel()
Dim ArData, ArNew()
Dim n&, nn&, nnn&


With Tabelle1 'Ausgangstabelle evtl. anpassen 
    'Datenbereich evtl. anpassen 
    'Datenbereich hier ab A2 
    'bis zur letzten Zelle in Spalte A 
    'bis zu letzten Zelle in Zeile 1 
    With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).EntireRow
        If .Rows(.Rows.Count).Row < 3 Then Exit Sub 'keine Daten 
        With .Columns(1).Resize(, .Cells(2, .Columns.Count).End(xlToLeft).Column)
            If .Columns(.Columns.Count).Column = 1 Then Exit Sub 'keine Daten 
            ArData = .Value
        End With
    End With
End With
Redim ArNew(1 To Ubound(ArData) * Ubound(ArData, 2), 1 To 3)

nnn = 1
ArNew(nnn, 1) = "Kriterium"
ArNew(nnn, 2) = "Wert"
ArNew(nnn, 3) = "Datum"
For nn = 2 To Ubound(ArData, 2)
    If ArData(1, nn) <> "" Then
        For n = 2 To Ubound(ArData)
            If ArData(n, nn) <> "" Then
                nnn = nnn + 1
                ArNew(nnn, 1) = ArData(n, 1)
                ArNew(nnn, 2) = ArData(n, nn)
                ArNew(nnn, 3) = ArData(1, nn)
            End If
        Next n
    End If
Next nn

'Ausgabe in neue Tabelle 
With ThisWorkbook
    With .Worksheets.Add(After:=.Sheets(.Sheets.Count))
        With .Cells(1, 1).Resize(Ubound(ArNew), Ubound(ArNew, 2))
            .Value = ArNew
            .Columns(3).NumberFormat = "dd.mm.yyyy"
            .Rows(1).Font.Bold = True
            .Rows(1).HorizontalAlignment = xlCenter
            .EntireColumn.AutoFit
        End With
    End With
End With

End Sub

Gruß Tino

For nn = 2 To Ubound(ArData, 2) If ArData(1, nn) <> "" Then For n = 2 To Ubound(ArData) If Not IsError(ArData(n, nn)) Then If ArData(n, nn) <> "" Then nnn = nnn + 1 ArNew(nnn, 1) = ArData(n, 1) ArNew(nnn, 2) = ArData(n, nn) ArNew(nnn, 3) = ArData(1, nn) ArNew(nnn, 4) = "=WEEKNUM(RC[-1])" 'KW ArNew(nnn, 5) = "=MONTH(RC[-2])" 'Monat ArNew(nnn, 6) = "=WEEKDAY(RC[-3])" 'Tag End If End If Next n End If Next nn

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten untereinander kopieren

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread