Makros laufen nicht
22.06.2005 17:15:44
GeorgK
ich habe in einem Ordner ca. 25 Exceldateien mit unterschiedlichen Namen.
Mit den nachfolgenden Makros versuche ich diese Daten zu übernehmen.
Mit einer Datei funktioniert das auch. Wenn ich aber das Makro über 6 mal hintereinander starte, findet Excel kein Ende mehr.
Da ich nur Recorder-Kenntnisse habe, füge ich jeweils die gleichen Makros - geändert um den Dateinamen - hintereinander.
Weiss jemand einen Rat?
Sub Sandprogramm()
Application.ScreenUpdating = False
Dim wb As Workbook
'Unterdrückt die Verknüpfungsabfrage
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Workbooks.Open "C:\Dokumente und Einstellungen\GeorgK\Desktop\Neue\berger.xls"
Set wb = ActiveWorkbook
Cells.Select
Selection.Copy
Windows("Proben1.5.xls").Activate
Sheets("Tabelle1").Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb.Close
Range("A4").Select
Call uebertragen
''''hier habe ich dann das nächste Makro Sandprogramm2 stehen usw. bis Sandprogramm25, jeweils geändert um den Dateinamen -oben "berger"-.
End Sub
Sub uebertragen()
Dim s As String
Application.ScreenUpdating = False
s = Sheets("Tabelle1").Range("B1").Value
Sheets("Tabelle1").Range("A2:B150").Copy _
Sheets(s).Range("A65536").End(xlUp).Offset(1, 0)
Sheets(s).Columns("B:B").ColumnWidth = 41
Sheets(s).Activate
Call MehrfZeiLö
End Sub
Vielen Dank und Gruß
Georg