Supportnet / Forum / Tabellenkalkulation
Makro
Frage
Hallo Leute,
ich habe folgendes Makro von coros bekommen was auch so weit funktioniert, es müßten jetzt nur noch ein paar änderungen gemacht, da ich mich mit VBA noch nicht so auskenne wende ich mich an euch.:
1. Es werden ja die ersten drei Tabellen Blätter komplett Kopiert, aber beim 2 Tabellen Blatt soll nur ein bestimmter Bereich kopiert werden ( A1:F45 )
2. Auf den Tabellen Blättern steht in eine Zelle ein Datum ( =heute() ), beim kopieren wird das Datum um 1 reduziert (z.B. 12.11.05 zu 11.11.05 ) an was könnte das liegen.
3. Wie muß ich das Makro ändern wenn nur Tabelle4 kopiert werden soll.
Sub Kopieren()
Dim Wiederholungen As Integer, Quelldatei As String, i As Integer, _
Neuer_Dateiname
Application.ScreenUpdating = False
Quelldatei = ActiveWorkbook.Name
Workbooks.Add
For Wiederholungen = 1 To 3
Sheets(Wiederholungen).Name = Workbooks(Quelldatei).Sheets(Wiederholungen).Name
Workbooks(Quelldatei).Sheets(Wiederholungen).Cells.Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteFormats
Next
i = MsgBox("SpeichernAktion kann nicht rückgängig gemacht werden!" & Chr(13) & _
"" & Chr(13) & _
"Sicher? Dann OK, sonst ABBRECHEN" & Chr(13), 1 + vbExclamation, "Festwerte in neue Datei speichern")
Rem wenn Abbrechen angeklickt, makroende
If i = 2 Then Exit Sub
Rem SpeichernDialog aufrufen
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:="", fileFilter:="Excel-Arbeitsmappe, *.xls")
If Neuer_Dateiname = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=Neuer_Dateiname
End Sub
Gruß
Achim
Antwort 1 von Event
Hallo
Zu 1.)
zu 2.) keine Idee ;(
zu 3.)
einfach ein neues Makro aufzeichnen.
Gruß
Zu 1.)
Option Explicit
Sub Kopieren()
Dim Wiederholungen As Integer, Quelldatei As String, i As Integer, Neuer_Dateiname
´Application.ScreenUpdating = False
Quelldatei = ActiveWorkbook.Name
Workbooks.Add
For Wiederholungen = 1 To 3
Workbooks(Quelldatei).Activate
Sheets(Wiederholungen).Name = Workbooks(Quelldatei).Sheets(Wiederholungen).Name
If Wiederholungen <> 2 Then
Workbooks(Quelldatei).Sheets(Wiederholungen).Cells.Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteFormats
Else
Workbooks(Quelldatei).Sheets(Wiederholungen).Range("A1:F45").Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteFormats
End If
Next
i = MsgBox("SpeichernAktion kann nicht rückgängig gemacht werden!" & Chr(13) & _
"" & Chr(13) & _
"Sicher? Dann OK, sonst ABBRECHEN" & Chr(13), 1 + vbExclamation, "Festwerte in neue Datei speichern")
Rem wenn Abbrechen angeklickt, makroende
If i = 2 Then Exit Sub
Rem SpeichernDialog aufrufen
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:="", fileFilter:="Excel-Arbeitsmappe, *.xls")
If Neuer_Dateiname = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=Neuer_Dateiname
End Sub
zu 2.) keine Idee ;(
zu 3.)
einfach ein neues Makro aufzeichnen.
Gruß
Antwort 2 von achim115
Hallo Event,
sorry das ich mich jetzt erst Melde,
Danke für deine Hilfe, jetzt komme ich wenigsten ein wenig weiter.
Danke,Danke
mfg
Achim
sorry das ich mich jetzt erst Melde,
Danke für deine Hilfe, jetzt komme ich wenigsten ein wenig weiter.
Danke,Danke
mfg
Achim