AW: @Matthias G: Brauche dich nochmal kurz
25.08.2005 17:31:50
Matthias
Hallo Daniel,
'Kopierroutine
Function KopiereBlatt(QMappe_Pfad As String, QMappe_Name As String, _
QBlatt_Name As String, ZBlatt_Name As String) As String
'Debug.Print QMappe_Pfad, QMappe_Name, QBlatt_Name, ZBlatt_Name
'Exit Sub
Dim WB_Q As Workbook
Dim WS_Q As Worksheet
Dim WS_Z As Worksheet
Dim Zieloffen As Boolean
Dim ErrMsg As String 'Fehlermeldung, bei möglichen Fehlern
On Error GoTo ERRHANDLER
'Mappe Master.xls bei Bedarf schreibgeschützt öffnen
If Not WBIsOpen(QMappe_Name) Then
ErrMsg = "Fehler beim Öffnen von """ & QMappe_Pfad & "\" & QMappe_Name & """"
Application.EnableEvents = False '<<< NEU
Workbooks.Open QMappe_Pfad & "\" & QMappe_Name, ReadOnly:=True, UpdateLinks:=False '<<< NEU
Application.EnableEvents = True '<<< NEU
ErrMsg = ""
Zieloffen = False
Else
Zieloffen = True
End If
'Prüfen, on Blatt existiert, b.B. erstellen
If Not WSExists(ThisWorkbook, ZBlatt_Name) Then
ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(Sheets.Count)
ThisWorkbook.ActiveSheet.Name = ZBlatt_Name
End If
'Variablen zuweisen
Set WS_Z = ThisWorkbook.Sheets(ZBlatt_Name)
Set WB_Q = Workbooks(QMappe_Name)
ErrMsg = "Blatt """ & QBlatt_Name & """ in " & QMappe_Name & " nicht vorhanden!"
Set WS_Q = WB_Q.Sheets(QBlatt_Name)
ErrMsg = ""
WS_Z.Cells.Delete 'Blattinhalt löschen
WS_Q.Cells.Copy 'Blattinhalt kopieren
'in Blatt Schmidt einfügen:
With WS_Z.Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
'.Select
End With
Application.CutCopyMode = False 'Kopiermarkiereung entfernen
'Quellmappe wieder schließen, wenn sie extra geöffnet wurde
If Not Zieloffen Then WB_Q.Close SaveChanges:=False
KopiereBlatt = ""
Exit Function
ERRHANDLER:
KopiereBlatt = IIf(ErrMsg = "", Err.Description, ErrMsg)
Err.Clear
End Function
Gruß Matthias