Microsoft Excel

Herbers Excel/VBA-Archiv

Makro Programmieren Hilfe!

Betrifft: Makro Programmieren Hilfe! von: Marc Schröter
Geschrieben am: 13.08.2020 15:49:23

Guten Tag zusammen,


leider habe ich ein paar kleine Probleme mit der Makroprogrammierung und erhoffe hier Hilfe zu bekommen.


Ich habe in einer Exceldatei 600 Arbeitsblätter die den Namen einer Artikelnummer haben (Bsp. 101, 102, 103). Auf den jeweiligen Blättern sind immer Daten in 22 Zeilen sowie 22 Spalten, die ich mithilfe eines Makros mit Nebeneinander anordnen lasse. Nun möchte ich diese, in einem Überischtsblatt darstellen, bei dem die Artikelnummer zu beginn steht und anschließend meine neu angeordneten Daten horizontal neben die Artikelnummer kopiert. Leider fügt mir der Makro die Daten immer wieder in die gleiche Zelle und Spalte ein. Gibt es eine Möglichkeit, es so zu programmieren, dass er sich immer die nächst leere Zeile aussucht, um das darein zu kopieren?


Anbei meine Beispieldatei

https://www.herber.de/bbs/user/139614.xlsx

Betrifft: AW: Makro Programmieren Hilfe!
von: Werner
Geschrieben am: 13.08.2020 16:00:11

Hallo,

und dein Makro ist jetzt wo?

In deiner Datei ist es nämlich nicht.

Gruß Werner

Betrifft: AW: Makro Programmieren Hilfe!
von: Marc
Geschrieben am: 14.08.2020 09:40:08

https://www.herber.de/bbs/user/139625.xlsm

Unter oben stehendem Link die Datei inklusive Makro. Sorry!!!!

Betrifft: AW: Makro Programmieren Hilfe!
von: Marc
Geschrieben am: 14.08.2020 09:34:43

Entschuldige, anbei mal mein Makro!

Probleme habe ich, da er mir immer wieder die gleichen Zeilen/Spalten überschreibt und nach dem Löschen einen Fehler Anzeigt da er sich nicht auf das nächste Tabellenblatt bezieht

Sub anordnen()
'
' anordnen Makro
'
' Tastenkombination: Strg+a
'
    Range("D5:I25").Select
    Selection.Cut
    Range("J4").Select
    ActiveSheet.Paste
    Range("J5:O24").Select
    Selection.Cut
    Range("P4").Select
    ActiveSheet.Paste
    Range("P5:U23").Select
    Selection.Cut
    Range("V4").Select
    ActiveSheet.Paste
    Range("V5:AA22").Select
    Selection.Cut
    Range("AB4").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    Range("AB5:AG21").Select
    Selection.Cut
    Range("AH4").Select
    ActiveSheet.Paste
    Range("AH5:AM20").Select
    Selection.Cut
    Range("AN4").Select
    ActiveSheet.Paste
    Range("AN5:AS19").Select
    Selection.Cut
    Range("AT4").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 21
    Range("AT5:AY18").Select
    Selection.Cut
    Range("AZ4").Select
    ActiveSheet.Paste
    Range("AZ5:BE17").Select
    Selection.Cut
    Range("BF4").Select
    ActiveSheet.Paste
    Range("BF5:BK16").Select
    Selection.Cut
    Range("BL4").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 36
    ActiveWindow.ScrollColumn = 37
    ActiveWindow.ScrollColumn = 38
    ActiveWindow.ScrollColumn = 39
    Range("BL5:BQ15").Select
    Selection.Cut
    Range("BR4").Select
    ActiveSheet.Paste
    Range("BR5:BW14").Select
    Selection.Cut
    Range("BX4").Select
    ActiveSheet.Paste
    Range("BX5:CC13").Select
    Selection.Cut
    Range("CD4").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 56
    ActiveWindow.ScrollColumn = 57
    Range("CD5:CI12").Select
    Selection.Cut
    Range("CJ4").Select
    ActiveSheet.Paste
    Range("CJ5:CO11").Select
    Selection.Cut
    Range("CP4").Select
    ActiveSheet.Paste
    Range("CP5:CU10").Select
    Selection.Cut
    Range("CV4").Select
    ActiveSheet.Paste
    Range("CV5:DA9").Select
    Selection.Cut
    Range("DB4").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 77
    ActiveWindow.ScrollColumn = 78
    ActiveWindow.ScrollColumn = 80
    ActiveWindow.ScrollColumn = 81
    Range("DB5:DG8").Select
    Selection.Cut
    Range("DH4").Select
    ActiveSheet.Paste
    Range("DH5:DM7").Select
    Selection.Cut
    Range("DN4").Select
    ActiveSheet.Paste
    Range("DN5:DS6").Select
    Selection.Cut
    Range("DT4").Select
    ActiveSheet.Paste
    Range("DT5:DY5").Select
    Selection.Cut
    Range("DZ4").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 101
    ActiveWindow.ScrollColumn = 102
    ActiveWindow.ScrollColumn = 103
    ActiveWindow.ScrollColumn = 105
    ActiveWindow.ScrollColumn = 100
    ActiveWindow.ScrollColumn = 94
    ActiveWindow.ScrollColumn = 87
    ActiveWindow.ScrollColumn = 80
    ActiveWindow.ScrollColumn = 72
    ActiveWindow.ScrollColumn = 65
    ActiveWindow.ScrollColumn = 59
    ActiveWindow.ScrollColumn = 55
    ActiveWindow.ScrollColumn = 50
    ActiveWindow.ScrollColumn = 47
    ActiveWindow.ScrollColumn = 44
    ActiveWindow.ScrollColumn = 42
    ActiveWindow.ScrollColumn = 39
    ActiveWindow.ScrollColumn = 37
    ActiveWindow.ScrollColumn = 36
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("D4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Sheets("78400").Select
    Range("D31").Select
    ActiveSheet.Paste
    Sheets("78400").Select
    Range("B31").Select
    ActiveSheet.Paste
    Sheets("13523100").Select
    ActiveWindow.SelectedSheets.Delete
End Sub


Betrifft: AW: Makro Programmieren Hilfe!
von: Werner
Geschrieben am: 14.08.2020 17:25:47

Hallo,

teste mal.
Schätze mal, dass das bei 600 Blättern Geschwindigkeitsmässig wohl nicht so berauschend sein wird.

Im Code musst du hier:
Case "Übersicht", "Tabelle1"

alle Blätter der Mappe aufführen, von denen keine Daten gezogen werden sollen.

https://www.herber.de/bbs/user/139642.xlsm

Gruß Werner