AW: Suche bzw. erstelle Tabellenblatt
01.03.2006 09:41:03
Rolli
Hallo Petra,
hat leider etwas gedauert.
klar geht das:!
Sub CopySheet()
Dim myTargetWbk As Workbook
Dim sSheetName$, lShtCnt&, bState As Boolean
'Tabelle 1 soll kopiert werden
'Namen des neuen Tabellenblatts auslesen
sSheetName = ThisWorkbook.Worksheets("Tabelle1").Cells(3, 1).Value
'Zieldatei öffnen
On Error Resume Next
Set myTargetWbk = Workbooks.Open(Filename:="C:\TEMP\Mappe1.xls")
'Überprüfen, ob schon eine Tabelle existiert
bState = False
For lShtCnt = 1 To myTargetWbk.Worksheets.Count
If myTargetWbk.Worksheets(lShtCnt).Name = sSheetName Then
'Wenn Tabelle existiert, bState auf True setzen
bState = True
Exit For
End If
Next
If bState = True Then
'Sheet bereits vorhanden --> nur Inhalt kopieren
ThisWorkbook.Activate
ThisWorkbook.Worksheets("Tabelle1").Range(Cells(1, 1), Cells(60, 15)).Copy
myTargetWbk.Worksheets(sSheetName).Range("A1").PasteSpecial Paste:=xlValues
myTargetWbk.Activate
myTargetWbk.Worksheets(sSheetName).Range("A1").Select
'ThisWorkbook.Activate
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Tabelle1").Range("A1").Select
Else
'Sheet nicht vorhanden
ThisWorkbook.Sheets("Tabelle1").Copy After:=myTargetWbk.Worksheets(Worksheets.Count)
myTargetWbk.Worksheets(Worksheets.Count).Name = sSheetName
End If
End Sub