Hallo Forumgemeinde,
ich habe eine komplexe Aufgabe bekommen und stoße nun an meine Grenzen. Vllt. kann mir an der Stelle jemand von Euch behilflich sein. Dafür schon mal Besten Dank.
Ich habe eine Datei die aus einer Vielzahl von Tabellenblättern besteht. Die einzelnen Tabellenblätter haben immer die gleiche Struktur, nur der Zellwert verändert sich. Ich suche jetzt nach einer Möglichkeit die immer gleichen Zelllbreiche (da ja jedes Tabellenblatt die gleiche Struktur hat) in ein einziges neues Tabellenblatt zu übertragen, so dass die Daten aus den Tabellenblättern als fortlaufende Liste gespeichert werden.
Ich hab das mal mit diesem Code hier probiert, der auch soweit funktioniert. Nur bin ich jedesmal wenn sich die Anzahl der Tabellenblätter ändert, dazu gezwungen das Makro wieder anzupassen. Durch dieses Forum hier habe ich gelernt, dass es Möglichkeiten gibt sämtliche Tabellenblätter z.B. mit einem Format zu Versehen, so viele wie halt vorhanden sind. Vllt. gibt es ja auch einen Code, der das Kopieren über sämtliche Tabellenblätter übernimmt. Ich denke, dass es hier schlaue Köpfe gibt, die das sicher sinnvoller programmieren würden:
Sub Kopieren()
'
' Kopieren Makro
'
' Tastenkombination: Strg+Umschalt+K
'
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Reich A. AIDe").Select
Range("C2").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Reich A. AIDe").Select
Range("C9:H39").Select
ActiveWindow.SmallScroll Down:=-3
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Batu AIDe").Select
Range("C2").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A32").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B32").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Batu AIDe").Select
Range("C9:H39").Select
ActiveWindow.SmallScroll Down:=-3
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Bergius AIDe").Select
Range("C2").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B63").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Bergius AIDe").Select
Range("C9:H39").Select
ActiveWindow.SmallScroll Down:=-3
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Wolf AIDe").Select
Range("C2").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A94").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B94").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Wolf AIDe").Select
Range("C9:H39").Select
ActiveWindow.SmallScroll Down:=-3
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Ich habe mir auf der Suche nach einer sinnvollen Variante schon die Finger wund gegoogelt, aber keinen brauchbaren Input gefunden, der mir an dieser Stelle weiter hilft. Vllt. war ich auch zu dauserig dazu.
Ich freue mich auf Eure Ideen.
ich habe eine komplexe Aufgabe bekommen und stoße nun an meine Grenzen. Vllt. kann mir an der Stelle jemand von Euch behilflich sein. Dafür schon mal Besten Dank.
Ich habe eine Datei die aus einer Vielzahl von Tabellenblättern besteht. Die einzelnen Tabellenblätter haben immer die gleiche Struktur, nur der Zellwert verändert sich. Ich suche jetzt nach einer Möglichkeit die immer gleichen Zelllbreiche (da ja jedes Tabellenblatt die gleiche Struktur hat) in ein einziges neues Tabellenblatt zu übertragen, so dass die Daten aus den Tabellenblättern als fortlaufende Liste gespeichert werden.
Ich hab das mal mit diesem Code hier probiert, der auch soweit funktioniert. Nur bin ich jedesmal wenn sich die Anzahl der Tabellenblätter ändert, dazu gezwungen das Makro wieder anzupassen. Durch dieses Forum hier habe ich gelernt, dass es Möglichkeiten gibt sämtliche Tabellenblätter z.B. mit einem Format zu Versehen, so viele wie halt vorhanden sind. Vllt. gibt es ja auch einen Code, der das Kopieren über sämtliche Tabellenblätter übernimmt. Ich denke, dass es hier schlaue Köpfe gibt, die das sicher sinnvoller programmieren würden:
Sub Kopieren()
'
' Kopieren Makro
'
' Tastenkombination: Strg+Umschalt+K
'
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Reich A. AIDe").Select
Range("C2").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Reich A. AIDe").Select
Range("C9:H39").Select
ActiveWindow.SmallScroll Down:=-3
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Batu AIDe").Select
Range("C2").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A32").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B32").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Batu AIDe").Select
Range("C9:H39").Select
ActiveWindow.SmallScroll Down:=-3
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Bergius AIDe").Select
Range("C2").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B63").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Bergius AIDe").Select
Range("C9:H39").Select
ActiveWindow.SmallScroll Down:=-3
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Wolf AIDe").Select
Range("C2").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A94").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B94").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Wolf AIDe").Select
Range("C9:H39").Select
ActiveWindow.SmallScroll Down:=-3
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Ich habe mir auf der Suche nach einer sinnvollen Variante schon die Finger wund gegoogelt, aber keinen brauchbaren Input gefunden, der mir an dieser Stelle weiter hilft. Vllt. war ich auch zu dauserig dazu.
Ich freue mich auf Eure Ideen.