Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1584to1588
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bestimmten Bereich kopiern, Schleife anhalten

Bestimmten Bereich kopiern, Schleife anhalten
21.10.2017 14:27:05
Thomas
Hallo Community ,
ich scheitere leider wieder bei einem Code :-(
Und zwar möchte ich in den Spalten A,B und C immer eine gewisse Anzahl an Zeilen in den Zwischenspeicher kopieren und auf Knopfdruck, (ob Taste oder Button is egal) der nächste Bereich kopiert werden.
Beispiel: Von A1:A30 , dann B1:B30, dann C1:C30 danach dann nur noch 28zeilen, also A31:A59 , B31:B59 usw.
Schön wäre auch, wenn man deutlich erkennen kann welche bereich sich gerade in der Zwischenablage befindet, hier dachte ich evtl an einen farblichen Hintergrund, oder das sich die Beschriftung auf dem Button ändert
Hier die Beispieldatei zur Veranschaulichung ...
Vielen Dank allen die sich hierfür die Zeit nehmen, anderen zu helfen
https://www.herber.de/bbs/user/117141.xlsm
Gruss Thomas

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bestimmten Bereich kopiern, Schleife anhalten
21.10.2017 16:49:09
Niclaus
Hallo Thomas
Ich weiss nicht, ob ich Dich richtig verstanden habe! A1:A30 kopieren. Dann etwas machen. Dann B1:B30 kopieren. Und dann etwas machen. Dann C1:C30 kopieren. Und dann etwas machen usw.
Wenn dem so wäre, würde ich es mit folgendem Makro machen:
Option Explicit
Public x
Option Base 1
Sub test()
Columns("A:C").Interior.Pattern = xlNone
x = x + 1
If x > 6 Then x = 1
Dim bereich(6)
Set bereich(1) = Range("A1:A30")
Set bereich(2) = Range("B1:B30")
Set bereich(3) = Range("C1:C30")
Set bereich(4) = Range("A31:A59")
Set bereich(5) = Range("B31:B59")
Set bereich(6) = Range("C31:C59")
bereich(x).Interior.Color = 65535
bereich(x).Copy
'Beispiel: Von A1:A30 , dann B1:B30, dann C1:C30
'danach dann nur noch 28zeilen, also A31:A59 , B31:B59 usw.
End Sub
Solange die Datei geöffnet bleibt, erhöht sich x um 1. Wenn Du sie schliesst und danach wieder öffnest, wird x zu 1 und das Spiel beginnt von vorne.
"danach dann nur noch 28zeilen": Das ist mir nicht ganz klar!
Grüsse Niclaus
Anzeige
AW: Bestimmten Bereich kopiern, Schleife anhalten
21.10.2017 17:29:49
Niclaus
Oder etwa so:
Option Explicit
Public x
Sub testVar2()
Dim Spalte%, Zeile1%, Zeile2%
Columns("A:C").Interior.Pattern = xlNone
x = x + 1
If x > 6 Then x = 1
Spalte = (x - 1) Mod 3 + 1
If x = 4 Then Zeile1 = 31: Zeile2 = Zeile1 + 28
With Range(Cells(Zeile1, Spalte), Cells(Zeile2, Spalte))
.Interior.Color = 65535
.Select
.Copy
End With
End Sub

AW: Bestimmten Bereich kopiern, Schleife anhalten
21.10.2017 21:00:54
Thomas
Hi Niclaus ,
vielen Dank, das geht schon genau in die richtige Richtung, allerdings kann ich nie vorhersagen wieviele Werte in der Spalte A stehen, das können dann auch mal 200 zeilen sein, also müsste der Code flexibel sein.
Und es wäre cool, wenn man nach dem letzten Bereich nochmal drück eine MsgBox mit "Fertig" aufpopt.
Gruß Thomas
Anzeige
AW: Bestimmten Bereich kopiern, Schleife anhalten
22.10.2017 09:58:04
Niclaus
Grüezi Thomas
Ich hoffe, so ist es besser!
Grüsse Niclaus

Option Explicit
Public y%
Sub testVar4()
Dim Spalte%, zeile1%, zeile2%, z%, rlast%, diffz2%
rlast = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
Columns("A:C").Interior.Pattern = xlNone
''y = 0
''start:
y = y + 1 ' Zähler 1, 2, 3, 4, 5 usw.
z = WorksheetFunction.RoundUp(y / 3, 0)
' Zähler 1,1,1,2,2,2,3,3,3,4,4,4 usw. für die Zeilenbearbeitung
Spalte = (y - 1) Mod 3 + 1  'Zähler 1,2,3,1,2,3 usw.
If y = 4 Then
zeile1 = (z - 1) * 28 + z + 1
zeile2 = z * 28 + z + 1
diffz2 = zeile2 - rlast
If diffz2 > 0 Then
zeile2 = zeile2 - diffz2
End If
End If
If zeile1 > rlast Then
Application.CutCopyMode = False
Range("A1").Select
y = 0
MsgBox "Ich habe fertig!", , Environ("UserName")
Exit Sub
End If
With Range(Cells(zeile1, Spalte), Cells(zeile2, Spalte))
.Interior.Color = 65535
.Select
.Copy
End With
End Sub

Anzeige
AW: Bestimmten Bereich kopiern, Schleife anhalten
22.10.2017 10:06:32
Thomas
Danke, so ist es perfekt.
Vielen Herzlichen Dank :-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige