AW: Tabellenblätter nebeneinander kopieren
03.11.2012 12:22:02
Gallanz
Sry für meine Unfähigkeit, VBA ist nicht wirklich mein Fachgebiet.
Ich habe aus deiner datei den folgenden Code
Option Explicit
Sub KopiereTabellen()
Dim Tabelle As Worksheet, Tabellen()
Dim rngLetzte As Range, strRange$
Dim NewWB As Workbook
'Tabellen erweitern oder und anpassen
Tabellen = Array("Tabelle1", "Tabelle2", "Tabelle3")
'zu kopierenter Bereich
strRange = "A1:CF550"
For Each Tabelle In ThisWorkbook.Sheets(Tabellen)
If NewWB Is Nothing Then
Set NewWB = Workbooks.Add(1)
End If
With NewWB.Worksheets(1)
If rngLetzte Is Nothing Then
Set rngLetzte = .Cells(2, 1)
Else
Set rngLetzte = .Cells(2, .Columns.Count).End(xlToLeft).Offset(, 2)
End If
rngLetzte.Offset(-1, 0) = Tabelle.Name
Tabelle.Range(strRange).Copy rngLetzte
End With
Next Tabelle
If Not NewWB Is Nothing Then
NewWB.Worksheets(1).UsedRange.entircolumn.AutoFit
End If
End Sub
Function CheckTab(strTabname$) As Boolean
On Error Resume Next
CheckTab = IsNumeric(ThisWorkbook.Sheets(strTabname).Index)
End Function
&
Option Explicit
Sub Makro1()
' Makro1 Makro
Sheets(Array("Tabelle1", "Tabelle3")).Select
Sheets("Tabelle1").Activate
End Sub
Beim 1. habe ich aus
Tabellen = Array("Tabelle1", "Tabelle2", "Tabelle3")
Tabellen = Array("Tabelle29", "Tabelle31", "Tabelle32", "Tabelle33", "Tabelle34", "Tabelle35", "Tabelle36", "Tabelle37")
gemacht
Was muss beim 2. geändert werden?
Gallanz