AW: Werte aus zweiter Datei übernehemen
13.09.2013 07:58:55
fcs
Hallo Peter,
das nachfolgende Makro baust du entweder in deine Ori_Master ein, oder in deine persönliche Makroarbeitsmappe.
Das Makro wird gestartet, wenn die Ori_Master die aktive Datei ist.
Die Werte-Datei kannst du auswählen, nachdem das Makro gestartet ist.
Gruß
Franz
Sub Hole_neue_Ori_Werte()
Dim wkbMaster As Workbook, wksMaster As Worksheet
Dim wkbWerte As Workbook, wksWerte As Worksheet
Dim varAuswahl As Variant
Dim rngSuchen As Range, rngNamen As Range
Dim Spalte_Name As Long
Dim ZeileTitel As Long
Dim Zeile_M As Long, Spalte_M As Long, iOffset As Long
Dim Zeile_W As Long, Spalte_W As Long, Zeile_WL As Long, Spalte_WL As Long
Spalte_Name = 2 ' Spalte B - Spalte mit namen
ZeileTitel = 3 'Titel-Zeile mit den Datumswerten
varAuswahl = Application.GetOpenFilename( _
Filefilter:="Exceldateien(*.xlsx;*.xls),*.xlsx;*.xls", _
Title:="Ori-Werte-Datei auswählen")
If varAuswahl = False Then Exit Sub
Set wkbMaster = ActiveWorkbook
Set wksMaster = wkbMaster.Worksheets(1)
Set wkbWerte = Application.Workbooks.Open(Filename:=varAuswahl, ReadOnly:=True)
Set wksWerte = wkbWerte.Worksheets(1)
With wksMaster
'letzte ausgefüllte Datumsspalte
Spalte_M = .Cells(ZeileTitel, .Columns.Count).End(xlToLeft).Column
End With
With wksWerte
'Letzte Spalte mit Datum in Titelzeile der Wertetabelle
Spalte_WL = .Cells(ZeileTitel, .Columns.Count).End(xlToLeft).Column
'Letzte Zeile mit Name der Wertetabelle
Zeile_WL = .Cells(.Rows.Count, Spalte_Name).End(xlUp).Row
End With 'wksWerte
For Zeile_W = ZeileTitel To Zeile_WL
With wksMaster
If Zeile_W > ZeileTitel Then
varAuswahl = wksWerte.Cells(Zeile_W, Spalte_Name).Value 'Name in Zeile einlesen
'Name in Master suchen
Set rngNamen = .Range(.Cells(ZeileTitel + 1, Spalte_Name), _
.Cells(.Rows.Count, Spalte_Name).End(xlUp))
Set rngSuchen = rngNamen.Find(what:=varAuswahl, LookIn:=xlValues, lookat:=xlWhole)
If rngSuchen Is Nothing Then
'Zeile für neuen Namen
Zeile_M = .Cells(.Rows.Count, Spalte_Name).End(xlUp).Row
'Neuen Namen in Master eintragen
.Cells(Zeile_M, Spalte_Name).Value = varAuswahl
Else
Zeile_M = rngSuchen.Row
End If
Else
Zeile_M = ZeileTitel 'Zeile für Datumswerte
End If
'Werte in Master eintragen
iOffset = 0
For Spalte_W = Spalte_Name + 1 To Spalte_WL
iOffset = iOffset + 1
.Cells(Zeile_M, Spalte_M + iOffset).Value = wksWerte.Cells(Zeile_W, Spalte_W).Value
Next 'Spalte_W
End With 'wksMaster
Next Zeile_W
wkbWerte.Close savechanges:=False
MsgBox "Fertig"
End Sub