Makro zum Übetragen von Tabellenblättern
20.10.2016 07:40:55
Tabellenblättern
Sub Schaltfläche1_Klicken()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim QWB As Workbook, ZWB As Workbook
Set QWB = Workbooks("Quelldatei.xls")
Set ZWB = Workbooks("Zieldatei.xls")
Workbooks.Open "Pfad...\Quelldatei.xls" 'hier die Frage ob der DateiPfad und Name in "" stehen _
muss
Workbooks.Open "Pfad...\Zieldatei.xls"
Dim QWS1 As Worksheet, ZWS1 As Worksheet
Dim QWS2 As Worksheet, ZWS2 As Worksheet
Set QWS1 = QWB.Worksheets("Sachmerkmal1") ' Quelle
Set ZWS1 = ZWB.Worksheets("Sachmerkmal1") ' Ziel
Set QWS2 = QWB.Worksheets("Sachmerkmal2") 'Quelle
Set ZWS2 = ZWB.Worksheets("Sachmerkmal2") 'Ziel
QWS1.Cells.Copy ZWS1.Cells(1, 1)
QWS2.Cells.Copy ZWS2.Cells(1, 1)
Workbooks("Quelldatei.xls").Close
Workbooks("Zieldatei.xls").SaveAs Filename:="Pfad...\Zieldatei.xls"
Workbooks("Zieldatei.xls").Close
Application.EnableEvents = True
End Sub