Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Makro erweitern





Frage

Hallo, ich habe folgendes Makro erstellt. Sub Makro1() ´ ´ Makro1 Makro Range("F5:F17").Select Selection.Copy Range("G2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True ActiveWindow.SmallScroll Down:=15 Range("F18:F30").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-18 Range("G3").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True ActiveWindow.SmallScroll Down:=18 Range("F31:F43").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-30 Range("G4").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True End Sub Was muss ändern damit jeweils in Spalte F die nächsten 13 Zellen kopiert (in der Folge wäre das hier F44-F56) und dann in Spalte G in der folgenden Zelle (hier jetzt als nächsters G5) eingefügt werden? Danke für Hilfe im Voraus. Gruß blau

Antwort 1 von JoeKe

Hallo Blau,

was willst du denn erreichen?
Im Momment kopierst du den Bereich F5:F17 und fügst ihn in G2 ein. Somit ist dann G2=F5, G3=F6, G4=F7 usw.
Anschließend kopierst du den Bereich F18:F30 und fügst ihn in G3 ein. Dadurch wird alles was du vorher eingefügt hast ab G3 überschrieben. Aus G3=F6 wird G3=F18 usw. Und beim nächsten kopier Vorgang wird alles ab G4 überschrieben usw.
Aus meiner Sicht leider nicht verständlich.

MfG

JöKe

Antwort 2 von nighty

hi all :)

ein versuch :))

gruss nighty

Option Explicit
Sub test()
Range("F5:F17").Copy
Range("G2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("F18:F30").Copy
Range("G3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("F31:F43").Copy
Range("G4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("F44:F56").Copy
Range("G5").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

Antwort 3 von nighty

hi jöke :)

Transpose:=True

gruss nighty

Antwort 4 von Blau

Hallo JöKe

ich kopieren den Bereich F5:F17 und füge ihn dann transponiert in G2 ein. Damit habe ich dann G2 = F5, H3 =F6, I3=F7 usw.
Mein Ziel ist jeweils 13 untereinanderliegende Zellen aus Spalte F in Zeilen zu verschieben, wobei der oberste Wert der 13 aus Spalte F jeweils untereinander in Spalte G wiedergegeben werden soll.
Gruß
blau

Antwort 5 von Blau

Hallo nighty,

dein Makro funktioniert.
Was kann ich denn machen, dass es nicht nach 4 Zeilen stoppt, sondern die ganze Spalte F ( immerhin 396 Zeilen) bearbeitet, ohne dass ich jeden Abschnitt einzeln nennen muss.
Gruß
blau

Antwort 6 von JoeKe

Hallo zusammen,

hab ich übersehen.

;-)

Gruß

JöKe

Antwort 7 von nighty

hi all :)

noch eine variante :)

gruss nighty

Option Explicit
Sub test()
Dim zaehler1 As Integer
Dim zaehler As Integer
zaehler1 = 5
For zaehler = 2 To 14
Range("F" & zaehler1 & ":F" & zaehler1 + 12).Copy
Range("G" & zaehler).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
zaehler1 = zaehler1 + 13
Next zaehler
End Sub

Antwort 8 von Blau

Hallo nighty,

auch das Makro läuft gut. Allerdings hört es auch schon nach 14 Zeilen auf (bei G 14).
Ich muss übrigens meine Zeilengesamtzahl korrigieren. Es sind über 5000 STück und das von Hand zu ändern dauert einfach zu lange.
Bin für weitere Hilfe dankbar.

Gruß
blau

Antwort 9 von nighty

hi all :)

vielleicht so :)

gruss nighty

Option Explicit
Sub test()
Dim zaehler1 As Integer
Dim zaehler As Integer
zaehler1 = 5
For zaehler = 5 To ActiveSheet.Range("F65536").End(xlUp).Row Step 13
Range("F" & zaehler1 & ":F" & zaehler1 + 12).Copy
Range("G" & zaehler).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
zaehler1 = zaehler1 + 13
Next zaehler
Application.CutCopyMode = False
End Sub

Antwort 10 von nighty

hi all :)

oh korrigiert

gruss nighty

Option Explicit
Sub test()
Dim zaehler1 As Integer
Dim zaehler As Integer
zaehler1 = 5
For zaehler = 2 To ActiveSheet.Range("F65536").End(xlUp).Row Step 13
Range("F" & zaehler1 & ":F" & zaehler1 + 12).Copy
Range("G" & zaehler).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
zaehler1 = zaehler1 + 13
Next zaehler
Application.CutCopyMode = False
End Sub

Antwort 11 von Blau

Hallo nighty,

jetzt läuft das Makro bis unten durch. Allerdings (schon wieder eine Einschränkung -:)) werden die Zeilen jetzt nicht in der Folge G5, G6 usw eingefügt, sondern immer in jeder 14. Zeile wiedergegeben. Also auf der Höhe des ersten Wertes der Abschnitte in der Spalte F.

Gruß blau

Antwort 12 von nighty

hi all :)

korrigiert denk ich :))

gruss nighty

Option Explicit
Sub test()
Dim zaehler1 As Integer
Dim zaehler As Integer
zaehler1 = 5
For zaehler = 2 To ActiveSheet.Range("F65536").End(xlUp).Row
Range("F" & zaehler1 & ":F" & zaehler1 + 12).Copy
Range("G" & zaehler).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
zaehler1 = zaehler1 + 13
Next zaehler
Application.CutCopyMode = False
End Sub

Antwort 13 von Blau

Hallo nighty,

bei mir kommt immer die Fehlermeldung "Laufzeitfehler´6´: Überlauf".

Gruß
Blau

Antwort 14 von nighty

hi bernd :)

ups muss ja auch integer statt long grr

was lange währt währt gut :))
zumindestens nähert man sich dem ziel :)))

gruss nighty

Option Explicit
Sub test()
Dim zaehler1 As long
Dim zaehler As long
zaehler1 = 5
For zaehler = 2 To ActiveSheet.Range("F65536").End(xlUp).Row
Range("F" & zaehler1 & ":F" & zaehler1 + 12).Copy
Range("G" & zaehler).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
zaehler1 = zaehler1 + 13
Next zaehler
Application.CutCopyMode = False
End Sub

Antwort 15 von Blau

Hallo nighty,

Das ist es!!!!
Vielen Dank!!
Jetzt kann´s weitergehen.

Gruß blau

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: