AW: Tabellenblätter nur Werte kopieren mit Kriteri
27.10.2006 22:09:01
Pet
Hallöchen Reinhard,
ich war nicht untätig *lach*. Schau mal was ich fabriziert habe (rumgegoogelt bis fast zum Erbrechen *gg*). Es funktioniert, allerdings bei dem Blatt VL_St_Ber muss ich statt A36, M1 angeben. Warum das so ist weiss ich nicht, aber vielleicht schaffe ich es ja irgendwann, dass mein Wissen ausreicht und mir Antwort gibt :-)
Ich danke dir für deine Hilfsbereitschaft und wer weiss? Vielleicht habe ich ja bald wieder eine Frage und hoffe, dass du mir dann auch wieder helfen wirst. Will doch jetzt etwas tiefer in die Zauberwelt des Programmierens eintauchen.
Danke das du mich nicht vergessen hast!
Lieben Gruß
Petra
----------
Option Explicit
Sub BlätterKopierenOhneFormeln()
Dim Blätter, B As Byte, Dateiname As String, PfadDatei As String
Dim Eingabe
Blätter = Array("VL_St_Ber", "VL_Std_Uebers")
Eingabe = InputBox("Dateiname", "Dateiauswahl", "MeineDatei")
If Eingabe = "" Then Exit Sub
On Error GoTo Fehler
Workbooks.Open Eingabe & ".xls"
On Error GoTo 0
With ActiveWorkbook
For B = 0 To UBound(Blätter)
ThisWorkbook.Worksheets(Blätter(B)).Copy After:=.Worksheets(.Worksheets.Count)
Next B
Application.DisplayAlerts = False
For B = 1 To .Worksheets.Count - 2
.Worksheets(1).Delete
Next B
With .Worksheets("VL_St_Ber")
.Name = "St_Ber_" & Format([M1], "mmm-yy")
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, operation:=xlNone, skipblanks:= _
False, Transpose:=False
End With
Application.CutCopyMode = False
With .Worksheets("VL_Std_Uebers")
.Name = "Std_Uebers_" & Format([M1], "mmm-yy")
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, operation:=xlNone, skipblanks:= _
False, Transpose:=False
End With
Application.CutCopyMode = False
Application.MaxChange = 0.001
.PrecisionAsDisplayed = False
.Date1904 = True
Application.DisplayAlerts = True
End With
Exit Sub
Fehler:
Workbooks.Add
ActiveWorkbook.SaveAs Eingabe & ".xls"
Resume Next
End Sub