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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
Das ist es!!!!
Vielen Dank!!
Jetzt kann´s weitergehen.
Gruß blau