AW: Tabellenblätter kopieren
19.09.2007 18:11:00
Swen
Hallo,
ich ahbe es so gemacht ich erstelle erst ein workbook und kopiere dann in dieses hineien!
mit diesem code,
Sub Daten_Archiv()
Dim strTemp As String, strPfad As String, strCamic As String, strTemp1 As String
Dim objSheet As Worksheet
If Worksheet_suchen("Coordinates") = True Then
strCamic = Worksheets("Coordinates").Cells(1, 7).Value
If Worksheets("Prog").Cells(1, 1).Value = "Network" Then
strPfad = Worksheets("Prog").Cells(2, 1).Value
Else
strPfad = Worksheets("Prog").Cells(3, 1).Value
End If
strTemp = Date$ & " - " & Worksheets("Coordinates").Cells(1, 1).Value _
& " - " & Worksheets("Coordinates").Cells(1, 7).Value
Ordner_erstellen (strPfad & "\ToolArchiv\")
If strCamic "" Then
strTemp1 = strPfad & "\ToolArchiv\" & strTemp & ".xls"
Workbooks.Add
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs (strTemp1)
Windows(ThisWorkbook.Name).Activate
With Workbooks(ThisWorkbook.Name)
'' For Each objSheet In .Worksheets
'' If objSheet.Visible = xlSheetVisible Or objSheet.Visible = True Then
'' objSheet.Select
'' objSheet.Copy After:=Workbooks(strTemp & ".xls").Sheets(1)
'' Windows(ThisWorkbook.Name).Activate
'' End If
'' Next
Dim Blaetter(), iI%, wb As Workbook
For Each objSheet In .Worksheets
If objSheet.Visible = xlSheetVisible Then
iI = iI + 1
ReDim Preserve Blaetter(1 To iI)
Blaetter(iI) = objSheet.Name
End If
Next
.Sheets(Blaetter()).Copy After:=Workbooks(strTemp & ".xls").Sheets(1)
End With
Windows(strTemp & ".xls").Activate
With Workbooks(strTemp & ".xls")
For Each objSheet In .Worksheets
If VBA.Left(objSheet.Name, 3) = "Tab" Then
objSheet.Delete
End If
Next
End With
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs (strTemp1)
ActiveWorkbook.Close
Windows(ThisWorkbook.Name).Activate
End If
End If
Windows(ThisWorkbook.Name).Activate
If Worksheet_suchen("Tabelle") = False Then
Worksheets.Add
ActiveSheet.Name = "Tabelle"
End If
With Workbooks(ThisWorkbook.Name)
For Each objSheet In .Worksheets
If Not objSheet.Name = "Tabelle" And objSheet.Visible = xlSheetVisible Then
Application.DisplayAlerts = False
objSheet.Delete
End If
Next
End With
End Sub
mein problem ist aber immer noch das in den tabellen bevor ich diese kopiere unter einander verknüpfungen sind und zwar werden einige zelle auf anderen zelle mit "=Coordinates!G10" auf andere zellen auf anderen tabellenblättern verknüpft so das sich eine änderung auf dem coordinates baltt durch das gesamte workbook durch zieht!
wenn ich also das neu erstellte workbook öffne dann fragt er mich immer ob er die verknüpfuungen aktualisieren soll.
Oder sind es evtl. andere verknüpfungen die er da meint?
gruß
swen