Erstellen neuer Arbeitsblätter mit Makro

[clbr44]

Hallo,
ich habe folgendes Problem:
Ich habe eine Excel Datei mit drei Arbeitsblättern. Auf allen Arbeitsblättern sind messergebnisse von drei unterschiedlichen Messungen aufgetragen, die miteinander verglichen werden sollen.
Dafür soll für jede Messung ein Neues Arbeitsblatt erstellt werden, auf dem die Ergebnisse der Versuche nebeneinander aufgetragen werden und am besten direkt auch grafisch dargestellt. Außerdem sollen noch einige einfache Berechnungen durchgeführt werden.
Jedes Arbeitsblatt soll im Prinzip gleich aussehn, nur die Werte unterscheiden sich.

In der angefügten Datei habe ich zur vereinfachung ein kleines Beispiel erstellt.
Im Beispiel sind die Blätter: Versuch A, Versuch B, Versuch C  meine gegebenen Blätter
Die Blätter Messung 1, Messung 2, Messung 3 sollen automatisch erstellt werden.


In meiner wirklichen Anwendung gibt es wesentlich mehr Werte und Messungen, so dass es eine Ewigkeit dauern würde alles händisch zu übertragen.
Würde mich sehr über eure hilfe freuen.

MFG

[shift-del]

Hallo

Hier mal ein Ansatz mit Power Query.

[clbr44]

danke hat mir super geholfen... habe zwar noch einige änderungen vorgenommen aber im großen und ganzen war das ne super idee...
:100:

[snb]

Ohne Powerquery doch mit VBA:

Code:

Sub M_snb()
    Set c_00 = CreateObject("scripting.dictionary")
    Set c_01 = CreateObject("scripting.dictionary")
    Set c_02 = CreateObject("scripting.dictionary")
    
    For j = 1 To 3
       sn = Sheets("versuch " & Chr(64 + j)).Cells(1).CurrentRegion
       
       For jj = IIf(j = 1, 1, 2) To UBound(sn)
          For jjj = 2 To UBound(sn, 2)
             sp = Array(sn(jj, 1), "versuch" & IIf(jj = 1, "", Chr(64 + j)), "Messung" & IIf(jj = 1, "", jjj - 1), IIf(jj = 1, "Wert", sn(jj, jjj)))
             If jjj = 2 Then c_00.Item(c_00.Count) = sp
             If jjj = 3 Then c_01.Item(c_01.Count) = sp
             If jjj = 4 Then c_02.Item(c_02.Count) = sp
         Next
       Next
    Next
    
    Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(c_00.Count, 4) = Application.Index(c_00.items, 0, 0)
    Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(c_01.Count, 4) = Application.Index(c_01.items, 0, 0)
    Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(c_01.Count, 4) = Application.Index(c_02.items, 0, 0)
End Sub