Copy Funktion

Sub Copy() Windows("exportExcelTable.xls").Activate Cells.Select Selection.Copy Windows("Zuordnung_exportExcelTable.xlsm").Activate ActiveSheet.Paste Windows("exportExcelTable.xls").Activate Application.CutCopyMode = False Workbooks("exportExcelTable.xls").Close SaveChanges:=False Workbooks("Zuordnung_exportExcelTable.xlsm").Close SaveChanges:=True End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Copy Funktion

04.01.2019 21:15:35

Dieter

Hallo Tom,
du musst deine Problemstellung sicher noch weiter präzisieren.
Ich habe dir mal als Diskussionsgrundlage ein Programm geschrieben, welches folgende Verarbeitung macht
- Öffnen der der beiden genannten Arbeitsmappen (Quelle und Ziel genannt), jeweils mit vorsorglichem Schließen
- Inhalt des 1. Blattes von Ziel löschen
- Inhalt des 1. Blattes von Quelle zum 1. Blatt von Ziel kopieren
- 1. Blatt von Ziel kopieren und am Schluss von Ziel einfügen
Dadurch nimmt die Anzahl der Blätter bei Ziel bei jedem Programmlauf um eins zu. Wahrscheinlich müssen da auch mal Blätter gelöscht werden.

Sub Kopieren()
Dim dateiQ As String  ' Quelle
Dim dateiZ As String  ' Ziel
Dim pfadQ As String
Dim pfadZ As String
Dim wbQ As Workbook
Dim wbZ As Workbook
Dim wsQ As Worksheet
Dim wsZ As Worksheet
pfadQ = ThisWorkbook.Path & "\"  ' ggf. anpassen
pfadZ = pfadQ                    ' ggf. anpassen
dateiQ = "exportExcelTable.xls"
dateiZ = "Zuordnung_exportExcelTable.xlsm"
' Quelle öffnen
If Dir(pfadQ & dateiQ) = "" Then
MsgBox pfadQ & dateiQ & vbNewLine & "existiert nicht"
Exit Sub
End If
On Error Resume Next
Workbooks(dateiQ).Close SaveChanges:=False
On Error GoTo 0
Set wbQ = Workbooks.Open(Filename:=pfadQ & dateiQ)
' Ziel öffnen
Set wsQ = wbQ.Worksheets(1)
If Dir(pfadZ & dateiZ) = "" Then
MsgBox pfadZ & dateiZ & vbNewLine & "existiert nicht"
Exit Sub
End If
On Error Resume Next
Workbooks(dateiZ).Close SaveChanges:=False
On Error GoTo 0
Set wbZ = Workbooks.Open(Filename:=pfadZ & dateiZ)
Set wsZ = wbZ.Worksheets(1)
' Inhalt von Blatt 1 der Zieldatei löschen
wsZ.UsedRange.Clear
' Inhalt von Blatt 1 der Quelldatei
' nach Blatt 1 der Zieldatei kopieren
wsQ.Cells.Copy Destination:=wsZ.Range("A1")
wbQ.Close SaveChanges:=False
' Blatt 1 der Zieldatei kopieren und am Ende einfügen
wsZ.Copy After:=wbZ.Sheets(wbZ.Sheets.Count)
wbZ.Save
wbZ.Close
End Sub

Viele Grüße
Dieter
https://www.herber.de/bbs/user/126496.xlsm

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread