Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro Bestimmte Zeilen in andere Tabelle kopieren

Makro Bestimmte Zeilen in andere Tabelle kopieren
19.09.2016 20:43:55
D.
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?

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
AW: Makro Bestimmte Zeilen in andere Tabelle kopieren
20.09.2016 17:13:34
D.
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.

329 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige