AW: Format übertragen ohne Fehlermeldung
30.12.2005 20:20:34
schoentalegg
Hallo Norman
Etwas ist mir unlogisch. Wenn Du schon eine Kopie deiner Exceldatei speicherst, wofür musst du dann noch einen Zellbereich hineinkopieren und das Format übertragen? Test2.xls ist ja schon ein Klon deiner Datei. Unlogisch ist für mich auch, wieso Du eine Datei öffnest, ohne dann etwas damit zu machen (Workbook.Add scheint mir überflüssig zu sein)
Ich habe trotzdem mal daran herumgebastelt:
Grundsätzlich muss ich sagen der Code ist nicht sehr dynamisch. Wenn Du einen Namen der Tabellenblätter oder der Datei änderst, dann läuft der Code nicht mehr. So wir dauernd auf eine Test1.xls zugegriffen Deine Forumsdatei heisst aber 29588.xls. Die Tabellenblätter der Kopie heissen bei meiner deutschen Version nicht "Sheet1" sondern "Tabelle1". Also hatte ich hier schon Probleme. Ich habe das mit Sheets(1) geändert, du kannst das dann wieder zurückmachen.
In deinem Code hast Du Probleme mit den Objekten. Zudem sind all die activate und select überflüssig. Statt workbook("xy").activate, sheets("xy").range("xy").select, selection copy kannst du auch schreiben workbook("xy").sheets("xy").range("xy").copy
VBA braucht die Zellen nicht zu selektieren, um sie bearbeiten zu können. Wenn Du dann die Workbooks und Tabellenblätter noch in Variablen verpackst (Dim wkb2 as workbook, set wkb2 = workbook("test2.xls")) wird alles nochmals übersichtlicher und deine Probleme mit den Objekten verschwinden.
Ich bin nur Hobby-Anwender und traute mich zu antworten, weil dir bisher niemand geschrieben hat. Ein Profi würde meinen Code wahrscheinlich noch anders schreiben. Probier ihn einfach mal aus.
Private Sub CommandButton1_Click()
Dim strMeldung As String, strTitel As String
Dim strVorschlag As String, strAntwort As String
Dim wkb1 As Workbook, wkb2 As Workbook
Dim wks1 As Worksheet, wks2 As Worksheet
'Objektvariablen immer mit set zuweisen
Set wbk1 = ThisWorkbook
Set wks1 = ThisWorkbook.Sheets(1)
strMeldung = "Datei speichern unter:"
strTitel = "Test"
strVorschlag = "Test2.xls"
strAntwort = InputBox(strMeldung, strTitel, strVorschlag)
wbk1.SaveCopyAs "C:\" & strAntwort
Set wbk2 = Workbooks.Open("C:\" & strAntwort)
Set wks2 = wbk2.Sheets(1)
wks1.Range("A1:N109").Copy Destination:=wks2.Range("A1:N109")
wks1.Cells.Copy
wks2.Range("a1").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
End Sub