Option Explicit
Dim j As Long, LSp As Long
Dim lz1 As Long
Sub Daten_kopieren()
Dim GD As Workbook 'WB Gasdaten
Dim GP As Workbook 'WB Gaspreis
Dim DSht As Worksheet 'Gasdaten Sheet
Dim PSht As Worksheet 'Gaspreis Sheet
Dim Tb1 As Worksheet 'This Workbbok
Set Tb1 = ThisWorkbook.Sheets("Tabelle1")
Set GP = Workbooks.Open(Filename:=CStr(Tb1.Range("G1")))
Set GD = Workbooks.Open(Filename:=CStr(Tb1.Range("G2")))
Set DSht = GD.Worksheets("Gasdaten") 'Sheets setzen
Set PSht = GP.Worksheets("Gaspreis")
ThisWorkbook.Activate
'LastZell in Daten, LastSpalte in Preis
lz1 = DSht.Range("A1").End(xlDown).Row
LSp = PSht.Cells(1, Columns.Count).End(xlToLeft).Column
'Kopiere Daten in Diese Tabelle A1
DSht.Range("A1:B" & lz1).Copy Tb1.Range("A1")
'Datum in Gaspreis suchen
For j = 2 To LSp
If PSht.Cells(1, j) = DSht.Cells(1, 2) Then Exit For
Next j
If j < LSp Then
'vorhandene Daten überschreiben
DSht.Range("B2:B" & lz1).Copy PSht.Cells(2, j)
Else
'neue Daten hinten anhängen
DSht.Range("B1:B" & lz1).Copy PSht.Cells(1, j)
End If
Range("B1").Activate
'Gaspreis aktivieren zum Prüfen
GP.Activate 'Gaspreis Aktivieren
GP.Save 'Gaspreis speichern
'Mappen schließen ???
GD.Close False 'Gasdaten schliessen
ThisWorkbook.Save 'Last Daten speichern
ThisWorkbook.Close 'Makro WB schliessen
End Sub
Sub M_snb()
With GetObject(Cells(1, 7))
sn = .Sheets("Gasdaten").Cells(1).CurrentRegion
.Close
End With
With GetObject(Cells(2, 7))
sp = .Sheets("Gaspreis").Cells(1).CurrentRegion
.Close
End With
For jj = 2 To UBound(sp, 2)
If sp(1, jj) = sn(1, 2) Then Exit For
Next
For j = 1 To UBound(sn)
sn(j, 2) = sp(j, jj)
Next
Cells(1).Resize(UBound(sn), 2) = sn
End Sub