875 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo liebe Community,

ich stehe grade auf den schlauch und bekomme es nicht hin ein VBA
code zu erstellen das von
Tabelle 1 jede 10 Zeile Spalte A:H in
Tabelle 2 freie Zeile kopiert

Ich wäre um Hilfe sehr dankbar.

Vielen Dank in vorrau.

MFG

atmon

2 Antworten

0 Punkte
Beantwortet von rainberg Profi (14.9k Punkte)
Hallo,

meine Vorschlag:

Option Explicit

Sub transfer()
Dim lngI As Long
Application.ScreenUpdating = False
For lngI = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Step 10
ActiveSheet.Range("A" & lngI & ":H" & lngI).Copy _
Worksheets(2).Range("A" & Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1)
Next
Worksheets(2).Select
Application.ScreenUpdating = True
End Sub


Gruß
Rainer
0 Punkte
Beantwortet von rudi4ad Mitglied (167 Punkte)
Hallo atmon

hier noch eine Version, die nur die Werte überträgt, dafür aber 10 mal schneller:
Sub Jede_Zehnte()
Dim aA, Startzeile&, i&, j&, k&
Dim wTab1 As Worksheet
Set wTab1 = Worksheets("Tabelle1")
Startzeile = 3 '1.Zeile, die kopiert werden soll
'vorausgesetzt die Tabelle beginnt in A1
aA = wTab1.Range("a" & Startzeile & ":h" & Range("a1").CurrentRegion.Rows.Count)
k = 2
For i = 11 To UBound(aA) Step 10
For j = 1 To UBound(aA, 2)
aA(k, j) = aA(i, j)
Next
k = k + 1
Next
For i = k To UBound(aA)
For j = 1 To UBound(aA, 2)
aA(i, j) = ""
Next
Next
Sheets("Tabelle2").Cells(1, 1).Resize(UBound(aA, 1), UBound(aA, 2)).Value = aA
End Sub

wenn man's denn wirklich braucht.
Ansonsten ist Excel für die Auswertung von Daten bestens gerüstet.
Der Autofilter erledigt die Sache doch ratz fatz.
Gehe in die Spalte rechts neben deiner tabelle.
Trage eine Formel ein z.B. =WENN(--RECHTS(ZEILE();1)=3;"x";"")
die deine gewünschten Zeilen kennzeichnet.
Gehe auf Filter
und schon hast du deinen Auszug.
...