Markos erstellen - definierte Werte in ein anderes Datenblatt kopieren

[FelixFelix29]

Hallo in die Runde,

folgende Problematik: Ich habe eine Excel-Datei mit zwei Datenblättern "Datenanalyse (automatisch)" und "Datenspeicherung (automatisch).
Ich habe nun Werte aus dem Quelldatenblatt (Datenanalyse (automatisch)) die in das Zieldatenblatt (Datenspeicherung (automatisch)) kopiert werden sollen wenn
ich auf einen Button klicke. Die Werte sind dabei später durch verschiedene Formeln berechnet.

Immer wenn ich auf den Button klicke sollen die Daten kopiert werden und zwar in die nächst leere Spalte.

Ein Mitglied dieses Forums hat mir bereits ein Makros zukommen lassen, welches perfekt funktioniert. Alle in der Mustertabelle gelb markierten Werte werden kopiert und es wird immer
die nächst leere Spalte im Zieldatenblatt genutzt.

Nun möchte ich noch die grün markiert Werte in die definierten Zellen kopieren. Heißt den bestehenden Markos erweitern (wenn das geht). Ich hoffe es kann mir hierbei jemand helfen.

Sub x()
Dim arr As Variant
Dim i As Long
Dim j As Long
Dim col As Long

arr = Worksheets("Datenanalyse (automatisch)").Range("A1:F42")

With Worksheets("Datenspeicherung (automatisch)")
  col = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
  .Cells(1, col) = arr(3, 2)
  j = 2
  For i = 6 To 15
   
    .Cells(j, col) = arr(i, 6)
    j = j + 2
  Next i
  For i = 19 To 28
    .Cells(j, col) = arr(i, 6)
    j = j + 2
  Next
 
  For i = 32 To 42
    .Cells(j, col) = arr(i, 3)
    j = j + 1
  Next
End With
End Sub

Vielen Dank schon Mal an jeden der sich versucht!

VG Felix

[UweD]

Hallo


so?

Code:

Sub x()
    Dim arr As Variant
    Dim i As Long
    Dim j As Long
    Dim col As Long
   
    arr = Worksheets("Datenanalyse (automatisch)").Range("A1:F42")
   
    With Worksheets("Datenspeicherung (automatisch)")
        col = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
         .Cells(1, col) = arr(3, 2)
         j = 2
         For i = 6 To 15
         
            .Cells(j, col) = arr(i, 6)
            .Cells(j + 1, col) = arr(i, 5)
            j = j + 3
         Next i
         For i = 19 To 28
            .Cells(j, col) = arr(i, 6)
            .Cells(j + 1, col) = arr(i, 5)
            j = j + 3
         Next
       
         For i = 32 To 42
            .Cells(j, col) = arr(i, 3)
            j = j + 1
         Next
       
        .Columns(2).Copy
        .Columns(col).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False

    End With
End Sub

LG UweD