Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1088to1092
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro beschleunigen oder kürzen!!

Makro beschleunigen oder kürzen!!
lisa

Hallo zusammen
Meine Frage an die Spezialisten
Wie bekomme ich mein Makro so umgestellt, dass nicht jedesmal das Quellworkbook geöffnet wird!!?
Sub Makro1()
Dim sName As String
sName = Range("c4")
Application.ScreenUpdating = False
Workbooks.Open Filename:= _
"W:\2009\KW " & Range("c3") & " _  tgl Linienkennzahlen.xls"
Sheets(sName).Select
Range("O13:O31").Copy
Windows("Mappe2").Activate
Range("c5").PasteSpecial Paste:=xlPasteValues
sName = Range("d4")
Workbooks.Open Filename:= _
"W:\2009\KW " & Range("d3") & " _  tgl Linienkennzahlen.xls"
Sheets(sName).Select
Range("O13:O31").Copy
Windows("Mappe2").Activate
Range("d5").PasteSpecial Paste:=xlPasteValues
sName = Range("e4")
Workbooks.Open Filename:= _
"W:\2009\KW " & Range("e3") & " _  tgl Linienkennzahlen.xls"
Sheets(sName).Select
Range("O13:O31").Copy
Windows("Mappe2").Activate
Range("e5").PasteSpecial Paste:=xlPasteValues
Windows("KW " & Range("e3") & " _  tgl Linienkennzahlen.xls").Activate
ActiveWindow.Close
End Sub
Gruß Lisa

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro beschleunigen oder kürzen!!
24.07.2009 13:57:39
Hajo_Zi
Hallo Lisa,
wenn Du was aus der Datei kopieren willst muss Sie geöffnet werden.
Workbooks("Mappe2").Range("c5").PasteSpecial Paste:=xlPasteValues
Bei mir hat jede Datei einen Dateityp. In Deiner Version .Xls

AW: Makro beschleunigen oder kürzen!!
24.07.2009 16:03:07
lisa
Hallo
Ja, dass ist klar! Ich muss die Datei öffnen.
Nun habe ich sie aber einmal aufgemacht, kopiere meine Daten aus der einen Tabelle in meine Zieldatei un dann aus der naächste und aus der nächsten....
Im Code steht aber immer wieder Workbook öffnen was zu Folge hat, dass dann immer wieder gefragt wird, die Datei ist bereits geöffnet soll die Datei erneut geöffnet werden?
Das will ich gern abstellen
Ich hoffe auf eure Hilfe
Lisa
Anzeige
AW: Makro beschleunigen oder kürzen!!
24.07.2009 16:48:38
Wolli
Hallo Lisa,
das Problem, das Du nicht wirst lösen können, ist, dass Du mehrere Dateien hast. Der Dateiname lautet ja "W:\2009\KW " & Range("c3") & " _ tgl Linienkennzahlen.xls", d.h. wenn in C3 "45" steht, heißt ndie Datei "W:\2009\KW 45 _ tgl Linienkennzahlen.xls", vermutlich wird für jede Kalenderwoche eine eigene Datei verwendet. Also musst Du auch jede einzelne Datei öffnen.
Es könnte natürlich sinnvoll sein, von vornherein alle Linenkennzahlen in eine einzige Datei zu packen, sofern das in Deinem Einflussbereich liegt.
Gruß, Wolli
AW: Makro beschleunigen oder kürzen!!
25.07.2009 05:27:39
Dirk
Hallo lisa,
versuche mal folgenden Code:
Sub Makro1()
Dim sName As String
Dim I As Integer
Dim Datei As String
On Error Resume Next
For I = 1 To 3
sName = Cells(4, 2 + I).Value
Datei = Cells(3, 2 + I).Value & " _  tgl Linienkennzahlen.xls"
If IstOffen(Datei) = False Then
Workbooks.Open Filename:="W:\2009\KW" & Datei
Else: End If
Workbooks(Cells(3, 2 + I).Value & " _  tgl Linienkennzahlen.xls").Sheets(sName).Range("O13: _
O31").Select
Selection.Copy
Workbooks("Mappe2.xls").Activate
Cells(5, 2 + I).Select
Selection.PasteSpecial Paste:=xlPasteValues
Next I
Application.CutCopyMode = False
Workbooks("KW " & Range("e3") & " _  tgl Linienkennzahlen.xls").Activate
ActiveWindow.Close
End Sub

Function IstOffen(fn As String) As Boolean
Dim wb As Workbook
For Each wb In Workbooks
If UCase(wb.Name) = UCase(fn) Then
IstOffen = True
Exit For
End If
Next wb
End Function
Gruß
Dirk R.
Anzeige
ExecuteExcel4Macro ohne öffnen
25.07.2009 06:20:59
Tino
Hallo,
hier mal eine Möglichkeit ohne die Dateien zu öffnen.
Sub Makro1()
Dim sName As String
Dim sFormel As String
Dim A As Long, AA As Long
         
'Tabellenname anpassen 
With ThisWorkbook.Sheets("Tabelle1")
     
     For AA = 3 To 5
        sName = Cells(4, AA) 'Tabellenname 
        
        For A = 13 To 31
         'Formel erstellen 
         sFormel = "'W:\2009\[KW " & Cells(3, AA) & " _  tgl Linienkennzahlen.xls]" & sName & "'!" & "R" & A & "C15"
         'Wert auslesen und in die Tabelle schreiben 
         .Cells(A - 8, AA) = ExecuteExcel4Macro(sFormel)
        Next A
     Next AA


End With

End Sub
Gruß Tino
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige