Sub NachDruckversion()

d.h. den Code in die Auffang.xlsm und nach Vorbemerkung ggf. anpassen

Gruß

Option Explicit
'***********************************************************************************
'Zieldateiname und Typ und die Tabellennamen sind ggf. direkt im Code zu ändern
'***********************************************************************************
Sub NachDruckversion()
'aktive Mappe = Auffang.xlsm
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 = Auffang.xlsm
If Workbooks.Count > 1 Then Exit Sub
'Seiten gefüllt, sonst Abbruch
With Sheets("Zweiteseite")
   If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With
With Sheets("Dritteseite")
   If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With


On Error GoTo eHandler
Application.ScreenUpdating = False

Workbooks.Open Filename:=ThisWorkbook.Path & "\Druckversion.xlsm"

'Mappe = Druckversion.xlsm - leeren
With Workbooks(2)
   With .Sheets("Zweite")
      .Cells.Clear
   End With
   With .Sheets("Dritte")
      .Cells.Clear
   End With
End With

'Daten aufnehmen
With Workbooks(1)
   'je Tabelle
   With .Sheets("Zweiteseite")
      'benutzer Bereich
      lngLast = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
      With .Columns("C:H")
         Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
         'in Datenfeld
         arrCH = rngQuelle.Value
      End With
      'ditto
      With .Columns("R:T")
         Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
         arrRT = rngQuelle.Value
      End With
   End With
   
   'ins Ziel schreiben
   Set rngZiel = Workbooks(2).Sheets("Zweite").Range("A1")
   rngZiel.Resize(UBound(arrCH, 1), UBound(arrCH, 2)).Value = arrCH
   'ditto
   Set rngZiel = Workbooks(2).Sheets("Zweite").Range("G1")
   rngZiel.Resize(UBound(arrRT, 1), UBound(arrRT, 2)).Value = arrRT
   
   'wie vor, andere Tabelle
   With .Sheets("Dritteseite")
      lngLast = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
      With .Columns("C:H")
         Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
         arrCH = rngQuelle.Value
      End With
      With .Columns("R:T")
         Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
         arrRT = rngQuelle.Value
      End With
   End With
   
   Set rngZiel = Workbooks(2).Sheets("Dritte").Range("A1")
   rngZiel.Resize(UBound(arrCH, 1), UBound(arrCH, 2)).Value = arrCH
   
   Set rngZiel = Workbooks(2).Sheets("Dritte").Range("G1")
   rngZiel.Resize(UBound(arrRT, 1), UBound(arrRT, 2)).Value = arrRT
   
End With
'speichern, schließen
Workbooks(2).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