VBA Werte in 2Tabellenblatt kopieren

[Topology]

Hallo,
Ich habe verschiedene Werte (QM1-QM7) diese sollen in das 2te Tabellenblatt kopiert werden,
sprich diese sollen sich aber bei aufrufen des 2ten Tabellen-Blatts immer wieder aktualisieren.

1. Es kann vorkommen das zwischen den QM's weitere Zeilen eingefügt werden, z.B. QM4.1 oder auch QM8 usw... diese müssen dann auch ins Tabellenblatt2
2. Nur die Werte in den orangen Spalten sollen mit kopiert werden, die Weißen nicht.
3. Es muss sich bei öffnen aktualisieren, ich habe zurzeit nur einen Botton erstellt (Button geht anfangs auch mal i.O.)


Nur die Roten Werte (QM?) übertragen und zusätzlich die Orangen Werte.
In der richtigen Tabelle sind dazwischen noch mehrere Spalten die nur frei stehen.
Anfang und Ende sollte auch nicht stehen.

kann mir jemand helfen? :):)

LG

[shift-del]

Hallo,

eine Lösung mit M-Code (Power Query).
Voraussetzung: Namenszuweisung QM1_bis_QM7 für den Bereich A2:F11.

Code:

let
   Source = Excel.CurrentWorkbook(){[Name="QM1_bis_QM7"]}[Content],
   #"Promoted Headers" = Table.PromoteHeaders(Source, [PromoteAllScalars=true]),
   #"Changed Type" = Table.TransformColumnTypes(#"Promoted Headers",{{"ANFANG", type text}, {"Wert A", Int64.Type}, {"Wert B", type number}, {"Wert C", type number}, {"Wert D", type number}, {"Wert E", type number}}),
   #"Removed Columns" = Table.RemoveColumns(#"Changed Type",{"Wert B", "Wert D"}),
   #"Filtered Rows" = Table.SelectRows(#"Removed Columns", each ([ANFANG] <> "ENDE"))
in
   #"Filtered Rows"

[UnsUwe]

Hallo,
ein Vorschlag von mir:

in ein normales Modul: (kann auch dem Button zugeordnet werden)

Code:

Sub copyQMWerte()
'
Dim iErsteZeile As Integer, iLetzteZeile As Integer
Dim c As Range
'
   With Sheets("Tabelle2")
       'ggf. Ziel-Bereich löschen?
       .Range(.Cells(3, "A"), .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, .Cells.SpecialCells(xlCellTypeLastCell).Column)).Clear
   End With
   With Sheets("Tabelle1")
       Set c = .UsedRange.Find("Wert A", LookIn:=xlValues)
       If Not c Is Nothing Then
           iErsteZeile = c.Row + 1
           iLetzteZeile = c.End(xlDown).Row
           Sheets("Tabelle2").Range("A3").Resize(iLetzteZeile - iErsteZeile + 1, 1).Value = .Range(.Cells(iErsteZeile, "A"), .Cells(iLetzteZeile, "A")).Value
           Sheets("Tabelle2").Range("B3").Resize(iLetzteZeile - iErsteZeile + 1, 1).Value = .Range(.Cells(iErsteZeile, "B"), .Cells(iLetzteZeile, "B")).Value
           Sheets("Tabelle2").Range("C3").Resize(iLetzteZeile - iErsteZeile + 1, 1).Value = .Range(.Cells(iErsteZeile, "D"), .Cells(iLetzteZeile, "D")).Value
           Sheets("Tabelle2").Range("D3").Resize(iLetzteZeile - iErsteZeile + 1, 1).Value = .Range(.Cells(iErsteZeile, "F"), .Cells(iLetzteZeile, "F")).Value
       End If
   End With

End Sub

in den Codebereich deiner "Tabelle2":

Code:

Private Sub Worksheet_Activate()
Call copyQMWerte
End Sub

[Topology]

hi,

vielen Dank in der Zwischenzeit =)
hab grad ein anderes Problem das ich zuerst lösen muss, dazu separater Beitrag,
dann wende ich mich dem zu und gebe Rückmeldung was geklappt hat =)


danke !!! ihr seit die besten!!!