bereich sheets 2-11 auslesen und in .... VBA
01.08.2014 20:26:22
Spenski
die datei hat über 15 tabellenblätter
aus den tabellenblättern 2-11 soll jeweils ein bestimmter tabellenbereich kopiert werden und dann nach und nach in einer bestimmten anordnung im
tabellenblatt 13 "Ergebnis" eingefügt werden.
die anordnung hab ich versucht darzustellen https://www.herber.de/bbs/user/91835.xlsx
ich würds eventuell mit dem makrorecorder hinbekommen aber es gibt einen grossen haken.
jede woche ändern sich die namen von sheet 2-11 ( es handelt sich um kalenderwochen , und die alte fällt raus , eine neue rutscht nach)
kann man irgendwie sagen das der code sich auf das wirklich 2te -11te tabellenblatt bezieht , nicht auf die namen?
kann mir da jemand weiterhelfen?
makrorec:
Sub Makro4()
Sheets("Tabelle2").Select
Range("A1:G8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle3").Select
Range("C6:I12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("B9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle4").Select
Range("A1:G8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("I1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle5").Select
Range("C6:I12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("I9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle6").Select
Range("A1:G8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("P1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle7").Select
Range("C6:I12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("P9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle8").Select
Range("A1:G8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("W1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle9").Select
Range("C6:I12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("W9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle10").Select
Range("A1:G8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("AD1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle11").Select
Range("C6:I12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ergebnis").Select
Range("AD9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Daten").Select
End Sub
gruss
christian