Clever-Excel-Forum

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

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

FelixFelix29

UweD