Supportnet Computer
Planet of Tech

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.)

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

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: