Kopieren vor schliessen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Steve,
füge in deine xlsm-Datei ein Klassenmodul ein, gib ihm den Namen "clsApp" und kopiere folgenden Code in das Klassenmodul.

' **********************************************************************
' Modul: clsApp  Typ: Klassenmodul
' **********************************************************************

Option Explicit

Public WithEvents xlApp As Excel.Application

Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
  If Wb.Name = theWorkbook Then
    If SheetExist(targetSheet, ThisWorkbook) Then
      With ThisWorkbook.Sheets(targetSheet)
        If SheetExist(sourceSheet1, Wb) Then .Range("S3") = Wb.Sheets(sourceSheet1).Range("G25")
        If SheetExist(sourceSheet2, Wb) Then .Range("T3") = Wb.Sheets(sourceSheet2).Range("B35")
      End With
    End If
  End If
End Sub

In ein allgemenes Modul kopierst du diesen Code. Hier nimmst du auch die Einstellungen bezüglich Datei- bzw. Tabellen-Namen vor.

' **********************************************************************
' Modul: basMain  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public ThisApp As New clsApp

'Einstellungen
Public Const theWorkbook As String = "Tabelle1.xlsx" 'Name der zu überwachenden Datei
Public Const targetSheet As String = "Blatt 2" 'Name der Zieltabelle
Public Const sourceSheet1 As String = "Blatt 1" 'Name der 1. Quelltabelle
Public Const sourceSheet2 As String = "Blatt 2" 'Name der 2. Quelltabelle
'Ende Einstellungen

Sub initialize()
  Set ThisApp.xlApp = Application
End Sub


Public Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function

In Das Modul "DieseArbeitsmappe" fügst du diesen Code ein.

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Open()
  Call initialize
End Sub

Einstellungen vornehmen, Datei speichern, schließen und wieder öffnen > testen.

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopieren vor schliessen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread