AW: Tabellenblätter aus Dateien kopieren
16.08.2005 09:59:36
Matthias
Guten Morgen Daniel,
so, hier mal ein erster Entwurf, muss alles in die Mappe "Schmidt.xls"
UserForm1 (zur Anzeige einer Meldung während des Kopierens)
Erstelle eine Userform, nur mit einem Label namens "Label1", sonst keine Steuerelemente.
Ins Userform-Modul dieser Code:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub
(Das sorgt dafür, dass die UF nicht übers Schließkreuz geffnet werden kann.)
---------------------------------------------------------------------------------
DieseArbeitsmappe:
ins Modul von DieseArbeitsmappe:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub
Private Sub Workbook_Open()
StartTimer
End Sub
Beim Öffnen der Mappe wird der Timer gestartet, der gleich beim Öffnen sowie dann alle 60 Minuten eine Prozedur startet.
Beim Schlißen der MAppe wird der Timer gestoppt.
---------------------------------------------------------------------------------
in ein normales Modul:>
Option Explicit
Public NextTime As Date
Sub StartTimer()
NextTime = Now + TimeValue("01:00:00") 'alle 60 Minuten
Kopieren
Application.OnTime NextTime, "StartTimer"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=NextTime, Procedure:="StartTimer", Schedule:=False
On Error GoTo 0
Application.StatusBar = False
End Sub
Function WBIsOpen(ByVal n As String) As Boolean
Dim wb As Workbook
For Each wb In Workbooks
If UCase(wb.Name) = UCase(n) Then
WBIsOpen = True
Exit Function
End If
Next wb
WBIsOpen = False
End Function
Sub Kopieren()
Const QBlatt_Name = "Auswertung" 'Quellblatt
Const ZMappe_Name = "Master.xls" 'Zielmappe
Const ZBlatt_Name = "Schmidt" 'Zielblatt
Dim WB_Z As Workbook
Dim WS_Z As Worksheet
Dim WS_Q As Worksheet
Dim Zieloffen As Boolean
With UserForm1
.Label1 = "Mappe """ & ZMappe_Name & """ wird aktualisiert..."
.Show False 'nichtmodal anzeigen, d.h. es wird nicht aufs Schließen der UF gewartet
End With
DoEvents 'damit UF vollständig angezeigt wird
Application.ScreenUpdating = False
If Not WBIsOpen(ZMappe_Name) Then
Workbooks.Open ThisWorkbook.Path & "\" & ZMappe_Name
Zieloffen = False
Else
Zieloffen = True
End If
Set WS_Q = ThisWorkbook.Sheets(QBlatt_Name)
Set WB_Z = Workbooks(ZMappe_Name)
Set WS_Z = WB_Z.Sheets(ZBlatt_Name)
WS_Z.Cells.Delete 'Blattinhalt löschen
WS_Q.Cells.Copy
With WS_Z.Range("A1")
.PasteSpecial xlPasteValuesAndNumberFormats
.PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False
'Mappe Master speichern...
WB_Z.Save
'... und wieder schließen, wenn sie extra geöffnet wurde
If Not Zieloffen Then WB_Z.Close
Unload UserForm1
Application.ScreenUpdating = True
End Sub
Ich gehe hier davon aus, dass sich die Mappe "Master.xls" im gleichen Ordner befindet wied Schmidt.xls, wenn gewünscht, noch anpassen
(die Zeile Workbooks.Open ThisWorkbook.Path & "\" & ZMappe_Name)
So, jetzt schau erstmal, wie das läuft...
Gruß Matthias