Code für Copy und Past einarbeiten
26.05.2022 22:44:49
Andreas
nun möchte ich am Ende noch folgendes abarbeiten.
bevor meine Wunschdatei Workbooks.Open lXlsxFile geschlossen wird, soll dort aus dem Workbooks "Deckblatt" der Zell-Bereich A14:M23 in "ThisWorkbook" ins Worksheet "Hilfstabelle EINGABE" in den Zell-Bereich A14:M23 eingefügt werden.,
Ich möchte das Macro aber nicht zerstören- Kann jemand beim Code helfen?
Sub Öffne_Wunschdatei()
Dim lXlsxFile As Variant, liSh As Integer, lboExist As Boolean
With Application
.EnableEvents = False 'Ereignisverfolgung wie z Bsp Zellwertänderung, andere Zelle auswählen, usw wird deaktiviert; WICHTIG!!!: wenn du eine Datei mit Makro öffnest, deren Makro nach Öffnen ausgeführt werden soll, musst du diese Zeile hier löschen
.DisplayAlerts = False 'Warnmeldung, z Bsp Frage, ob eine Tabelle wirklich gelöscht werden soll, wird deaktiviert
End With
'wenn es das Verzeichnis "D:\Elektro Arbeit\Bestands-Datein" gibt, wird vor der Dateiauswahl in das Verzeichnis gewechselt (das erspart dir, erst mal das richtige Verzeichnis auszuwählen ;-) )
If Dir("D:\Elektro Arbeit\Bestands-Datein", vbDirectory) "" Then
ChDrive "D:\"
ChDir "D:\Elektro Arbeit\Bestands-Datein"
End If
'es öffnet sich der Datei-Auswahl-Dialog
lXlsxFile = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
'Abbrechen oder ESC-Taste, wird das Makro beendet
If lXlsxFile = False Then Exit Sub
'die ausgewählte Datei wird geöffnet
Workbooks.Open lXlsxFile
With ThisWorkbook
'es wird geprüft, ob in - dieser Datei hier - eine Tabelle "Bestand_Bearb." vorhanden ist
For liSh = 1 To .Sheets.Count
If .Sheets(liSh).Name = "Bestand_Bearb." Then
lboExist = True
Exit For
End If
Next
'wenn "Bestand" vorhanden, wird darauf hingewiesen und gefragt, ob diese gegen "Bearbeiten" aus Wunschdatei ausgetauscht werden soll
If lboExist = True Then
'wenn JA, wird alte "Bestand_Bearb." gelöscht, "Bearbeiten" aus Wunschdatei ganz links eingefügt, in "Bestand_Bearb." umbenannt
If MsgBox("Die Tabelle ''Bestand_Bearb.'' ist schon vorhanden." & vbCrLf & "Sollen die Werte in ''Bestand_Bearb.'' mit den Werten aus '' Wunschdatei'' überschrieben werden?", vbQuestion + vbYesNo, "Frage") = vbYes Then
.Sheets("Bestand_Bearb.").Delete
Sheets("Bearbeiten").Copy Before:=.Sheets(1)
.Sheets(1).Name = "Bestand_Bearb."
End If
Else
'wenn "Bestand_Bearb." nicht vorhanden, wird "Bearbeiten" aus Wunschdatei "ungefragt" ganz links eingefügt + in "Bestand_Bearb." umbenannt
Sheets("Bearbeiten").Copy Before:=.Sheets(1)
.Sheets(1).Name = "Bestand_Bearb."
End If
End With
With Application
.EnableEvents = True 'Ereignisverfolgung wird wieder aktiviert
.DisplayAlerts = True 'Warnmeldungen werden wieder aktiviert
End With
'hier wird Wunschdatei ohne Speichern geschlossen
Workbooks(Split(lXlsxFile, "\")(UBound(Split(lXlsxFile, "\")))).Close False
End Sub
Grüße Andreas