Makro Bestimmte Zeilen in andere Tabelle kopieren

Forumthread: Makro Bestimmte Zeilen in andere Tabelle kopieren

19.09.2016 20:43:55

So nun mal noch Datei mit hochgeladen-
https://www.herber.de/bbs/user/108275.zip
Teil 1 geht- also ausgewählte Zellen der Tabelle1 in neue Tabelle "Bearbeiten" Kopieren... nun soll es auch wieder zurück gehen!
also nach Änderungen auf der Tabelle "Bearbeiten" sollen diese wieder in den Zellen der "Tabelle1" nach folgenden Muster eingefügt werden.
Zeilen 1-30 von Tabelle"Bearbeiten" nach Zeile 20 - 49 der "Tabelle1"
weiter " 31-60 " " " 69 - 98 "
weiter " 61-90 " " " 118- 147 "
weiter " 91-120 " " " 167- 196 "
und das ganze so weiter bis Zeile 5000 kopieren.
Kurz gesagt Zeile 1-30 der Tabelle"Bearbeiten" nach "Tabelle1" und Start bei 20
Zeile 31-60 " Start bei 69
Zeile 61-90 " Start bei 118
bis 5000 kopieren.
Kann jemand nachhelfen?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Wieso immer ein neues Thread ?

20.09.2016 06:49:12

baschti007

AW: Makro Bestimmte Zeilen in andere Tabelle kopieren

20.09.2016 07:07:03

baschti007

Und wenn du meine Lösung von gestern nicht versucht hast bist du selber schuld =D
Hier noch mal die beiden Lösungen von Gestern ;)


Sub Von_Tabelle1_nach_Bearbeitung()
Dim Zeile As Long
Dim Zeile2 As Long
Dim StartZeile As Long
Dim last As Long
Dim arr
Dim x As Long
Dim y As Long
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets("Tabelle1")
Set Ws2 = ThisWorkbook.Worksheets("Bearbeitung")
Application.ScreenUpdating = False
last = 1
StartZeile = 20
x = 0
y = 0
arr = Array(30, 19, 30, 19) ' JA,NEIN,JA,NEIN
Zeile = StartZeile
Zeile2 = StartZeile
Do
If Zeile > 5000 Then Exit Do
Zeile2 = Zeile2 + arr(x) - 1 + y
If Not x Mod 2  0 Then
Ws1.Rows(Zeile & ":" & Zeile2).EntireRow.Copy
Ws2.Cells(last, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
last = last + arr(x)
End If
Zeile = Zeile + arr(x)
y = 1
If x = UBound(arr) Then x = 0: GoTo xx
x = x + 1
xx:
Loop
Application.ScreenUpdating = True
End Sub


Sub Von_Bearbeitung_nach_Tabelle1()
Dim Zeile As Long
Dim Zeile2 As Long
Dim StartZeile As Long
Dim last As Long
Dim arr
Dim x As Long
Dim y As Long
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets("Tabelle1")
Set Ws2 = ThisWorkbook.Worksheets("Bearbeitung")
Application.ScreenUpdating = False
last = 20 ' Start von Tabelle 1
StartZeile = 1 ' Start von Bearbeitung
x = 0
y = 0
arr = Array(30, 19, 30, 19) ' JA,NEIN,JA,NEIN
Zeile = StartZeile
Zeile2 = StartZeile
Do
If Zeile > 5000 Then Exit Do
If Not x Mod 2  0 Then
Zeile2 = Zeile2 + arr(x) - 1 + y
Ws2.Rows(Zeile & ":" & Zeile2).EntireRow.Copy
Ws1.Cells(last, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
last = last + arr(x)
Zeile = Zeile + arr(x)
Else
last = last + arr(x)
End If
y = 1
If x = UBound(arr) Then x = 0: GoTo xx
x = x + 1
xx:
Loop
Application.ScreenUpdating = True
End Sub

Gruß Basti

AW: Makro Bestimmte Zeilen in andere Tabelle kopieren

20.09.2016 17:13:34

Danke Basti,
Ich hab das gestern nicht gleich gesehen- das von dir geschrieben Makro läuft und macht genau das was es soll. So kann ich es auch besser nachvollziehen- wenn etwas läuft und ich dann Veränderungen vornehme. Danke nochmals.

Beliebteste Forumthreads (12 Monate)

Makro Bestimmte Zeilen in andere Tabelle kopieren

Forumthread: Makro Bestimmte Zeilen in andere Tabelle kopieren

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Makro Bestimmte Zeilen in andere Tabelle kopieren

Forumthread: Makro Bestimmte Zeilen in andere Tabelle kopieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread