Kopieren mit Makro

[basti1912]

Hallo, ich habe schon einmal ein Anfrage gestellt, wo ich Nachhinein jedoch feststellen musste, dass es etwas zu umständlich war. Ich habe es jetzt stark vereinfacht. 

Ich hätte gern wenn in A1 eine "1" steht, dass der Bereich F4:G6 in C4: D6 kopiert wird. Sollte in A1 eine "2" stehen soll I4:J6 kopiert werden. 

Es gibt jetzt wohl 2 Anzätze; über eine Wenn-Dann-Funktion als Formel+ Makro oder über ein Makro was durch ein Feld aktiviert wird!? Beides bekomme ich leider nicht hin. 


  Mappe1-2.xlsx (Größe: 8,32 KB / Downloads: 3)

Vielen Dank im Voraus und ein sonniges Wochenende... ;)

Gruß
Basti

[schauan]

Hallo Basti,

die Formel wäre doch recht simpel, für die erste Zelle imBereich
=WENN(A1=1;F4;WENN(A1=2;I4;""))

[basti1912]

Hallo, 

das stimmt wohl, jedoch ist das hier sehr vereinfacht und ich habe bis zu 65 Zeilen wo ich jeweils 2 Formeln schreiben müsste, da es bis zu 12 Mannschaft gibt. Daher wollte ich den komplette Block mit einer Formel/einem Makro kopieren. 

Gruß

[schauan]

Hallo basti,

das mit den 2 Formeln versteh ich jetzt nicht. Ich hätte eher darauf getippt, dass Du die Formel auf 12 Mannschaften erweitern musst, im Prinzip
=WENN(A1=1;F4;WENN(A1=2;I4;WENN(A1=3;K4;""))) ?
Die Formel brauchst Du dann auch nur über den jeweiligen Bereich ziehen und sie nicht in jede Zelle einzeln einzuschreiben.

Was meinst Du denn mit 2 Formeln?

[basti1912]

Hi... 

ich meine, ich will das so aufbauen, dass zwischen 3 und 12 Mannschaften mitmachen können. Und der Spielplan ändert sich jedes Mal, wenn ich eine andere Anzahl an Mannschaften habe. Und dann müsste ich jeweils für Heim- und Auswärts die Formel schreiben, welche in meinen Augen (wenn ich das richtig verstehe) sehr sehr umfangreich ist. Das wären dann halt zum Teil 12 Wenn-Verschachtelungen pro Formel. 

Daher wollte ich jeweils den ganzen Block einfach kopieren. Zumindest dachte ich, dass dies so möglich ist... 

Danke.

[schauan]

Hallöchen,

dann so:

Code:

Sub rumundnum()
If Cells(1, 1).Value > 0 Then Cells(4, 6).Offset(0, (Cells(1, 1).Value - 1) * 3).Resize(3, 2).Copy Cells(4, 3)
End Sub

Bei dieser Variante müsstest Du einen Button einfügen und ihm das Makro zuweisen. Gehe z.B. mit Alt+F11 in den VBA-Editor, füge dort ein Modul ein und anschließend das Makro. Dann kannst Du es dem Button zuweisen.

[basti1912]

Hallo, 

das funktioniert, super danke! jetzt muss ich schauen, wie sich es auf die anderen Tabellen anwende und mehrere Variablen einbaue. 

Ich probier mich da nen bisschen aus und melde mich dann wieder. VIELEN DANK!

[basti1912]

Hallo, 

leider habe ich es nicht geschafft, deine Formel so zu erweitern, dass ich diese anwenden kann, daher habe ich noch weiter rumgesetzte und für mich doch ne sehr gute und gar nicht so schwere Lösung gefunden, welche auch ohne Probleme erweitert werden kann:

Sub MeineLösung
If Cells(1, 1).Value = 1 Then
    Range("F4:G6").Select
    Selection.Copy
    Range("C4: D6").Select
    ActiveSheet.Paste
End If

If Cells(1, 1).Value = 2 Then
    Range("I4:J6").Select
    Selection.Copy
    Range("C4: D6").Select
    ActiveSheet.Paste
End If
End Sub

Viele Grüße und ein schönes Wochenende. ;)

[BoskoBiati]

Hallo,

das geht einfacher so:

Code:

Sub AndereLösung()
Dim rng As Range
Select Case Cells(1, 1)
    Case 1
        Set rng = Range("F4:G6")
    Case 2
        Set rng = Range("I4:J6")
End Select
    rng.Copy Range("C4:D6")
End Sub

[schauan]

Hallo Basti,

meine Lösung setzt voraus, dass die zu kopierenden Bereiche in gleichem "Rhythmus" und gleicher Größe in Deiner Tabelle stehen. Bei 3 wäre das L4:M6, bei 4 O4:P6 usw., der Code funktioniert über die gesamte Blattbreite (ich hab jetzt am rechten Ende nicht geprüft, ob es für Offset und Resize noch reicht :-( ).
Beginnen tut es in F4 = Spalte 6, Zeile 4
Das findest Du hier:
If Cells(1, 1).Value > 0 Then Cells(4, 6).Offset(0, (Cells(1, 1).Value - 1) * 3).Resize(3, 2).Copy Cells(4, 3)

Ausgehend von Spalte 6 beginnen die nächsten Bereiche jeweils 3 Spalten später. Das habe ich so umgesetzt:
If Cells(1, 1).Value > 0 Then Cells(4, 6).Offset(0, (Cells(1, 1).Value - 1) * 3).Resize(3, 2).Copy Cells(4, 3)

Offset enthält den Zeilen- und Spaltenversatz.
Zeile bleibt gleich, also kein Offset bzw.
0

Der wievielte Bereich oder Spaltenversatz es ist, ergibt sich aus dem Inhalt von A1 und da ich bei Eingabe von 1 den ersten Bereich möchte und daher nicht offsetiere, bei Eingabe von 2 ausgehend vom ersten Bereich um eins offsetiere usw. muss ich noch 1 von der eingegebenen Zahl abziehen. Das Ergebnis muss ich mit 3 multiplizieren, da ja die Bereiche alle 3 Spalten beginnen.
Cells(1, 1).Value - 1) * 3

Da ich beim Offset immer nur von der linken oberen Ecke eines Bereiches ausgehe, muss ich die offsetierte Zelle natürlich noch auf die Größe des Bereiches ausdehnen, also 3 Zeilen hoch und 2 Spalten breit.
Resize(3, 2)