In Excel 2013 funktioniert das Kopieren - in Excel
12.03.2016 17:24:54
jojue
mit Nachfolgendem Code kopiere ich Werte von bezeichneten Spalten vom Exceldokument Rückmeldungen in das Dokument Durckversion. In der Version Excel 2013 funktioniert das Kopieren Fehler frei, das heisst, schliesse ich das Dokument kopiert es die Werte automatisch in das andere gewünschte Dokument.
In der Version Excel 2010, funktioniert das kopieren nicht mehr automatisch, wenn ich das Dokument schliesse. Es funktioniert dann nur, wenn ich des über die das "grüne Pfeilchen" Makro ausführen manuel auslöse, dann aber kopiert es alle Werte ins andere Dokument.
Wer kann mir weiterhelfen?
Besten Dank für eure Mithilfe
Gruss
jojue
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'speichert Dokument beim Schliessen automatisch
Save
'kopiert bei Beenden / Schliessen die Werte vom Dokument Rückmeldungen in das Dokument _
Druckversion
DieseArbeitsmappe.NachDruckversion
End Sub
'aktive Mappe = Rückmeldungen.xlsm
Dim wbQ As Workbook, wbZ As Workbook
Dim arrCH() As Variant 'Datenfeld1
Dim arrRT() As Variant 'Datenfeld2
Dim rngZiel As Range 'Zielzelle
Dim rngQuelle As Range 'zu verschiebende Daten
Dim lngLast As Long 'jew. letzte Zeile
'nur aktive Mappe = Rückmeldungen.xlsm
If Workbooks.Count > 1 Then Exit Sub
'Seiten gefüllt, sonst Abbruch
With Sheets("spezialversorgung")
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With
With Sheets("info")
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With
On Error GoTo eHandler
Application.ScreenUpdating = False
Set wbQ = ActiveWorkbook
Workbooks.Open Filename:=ThisWorkbook.Path & "\Druckversion.xlsx"
Set wbZ = ActiveWorkbook
'Mappe = Druckversion.xlsx - leeren
wbZ.Sheets("spezialversorgung").Cells.Clear
wbZ.Sheets("info").Cells.Clear
'Daten aufnehmen in Rückmeldungen (wbQ) und Übertragen in Druckversion (wbZ)
'Mappe spezialversorgung
lngLast = wbQ.Sheets("spezialversorgung").Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
wbQ.Sheets("spezialversorgung").Range("C1:H" & lngLast).Copy wbZ.Sheets("spezialversorgung").Range("A1")
wbQ.Sheets("spezialversorgung").Range("O1:T" & lngLast).Copy wbZ.Sheets("spezialversorgung").Range("G1")
wbQ.Sheets("spezialversorgung").Range("K1:K" & lngLast).Copy wbZ.Sheets("spezialversorgung").Range("I1")
'Mappe info
lngLast = wbQ.Sheets("info").Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
wbQ.Sheets("info").Range("C1:H" & lngLast).Copy wbZ.Sheets("info").Range("A1")
wbQ.Sheets("info").Range("O1:T" & lngLast).Copy wbZ.Sheets("info").Range("G1")
wbQ.Sheets("info").Range("K1:K" & lngLast).Copy wbZ.Sheets("Info").Range("I1")
'speichern, schließen
wbZ.Close True
eHandler:
Select Case Err.Number
Case 0 'erfolgreich
Case Else
MsgBox "Fehler bei der Ausführung"
End Select
Application.ScreenUpdating = True
End Sub