AW: Namensliste
05.11.2015 19:56:42
fcs
Hallo Holger,
nachfolgend ein Gerüst für ein entsprechend es Makro in dem du die Blattnamen und die Spalten etc. noch entsprechend anpassen musst.
Da die Aktualisierung nur einmal pro Monat erforderlich ist sollte dieses Makro von Hand gestartet werden, wenn die Daten im Blatt Tabelle1 durch den Export aktualisiert worden sind.
Über einen Kontrolleintrag, den das Makro unterhalb der Namen einfügt, wird das Makro so gesteuert, dass die Namen in Tabelle2 nur aktualisiert werden, wenn die Daten Tabelle1 durch den Export üerschrieben wurden.
Die Beispieldatei ist so eingericht, dass beim Öffnen der Datei automatisch das AKtualisierungsmakro ausgeführt wird.
https://www.herber.de/bbs/user/101276.xlsm
Gruß
Franz
Sub Aktualisieren_Namen()
Dim wksNamen As Worksheet
Dim wksData As Worksheet
Dim strName As String
Dim rngName As Range
Dim Zeile_N As Long, Zeile_D As Long
'Tabellenblatt in das die Daten monatlich exportiert werden
Set wksNamen = ActiveWorkbook.Worksheets("Tabelle1") 'Name ggf. anpassen
Const SpaName_N = 2 'Spalte B - Spalte mit Namen - Nummer ggf. anpassen
'Tabellenblatt in das die Namen übertragen werden sollen
Set wksData = ActiveWorkbook.Worksheets("Tabelle2") 'Name ggf. anpassen
Const SpaName_D = 1 'Spalte A - Spalte mit Namen - Nummer ggf. anpassen
With wksNamen
'Prüfen, ob Kontrolleintrag vorhanden unterhalb der Namen
Zeile_N = .Cells(.Rows.Count, SpaName_N).End(xlUp).Row
If Left(.Cells(Zeile_N, SpaName_N).Text, Len("Uebertragen am")) _
= "Uebertragen am" Then
'Daten sind nicht aktualisiert worden
Else
'Namen in Spalte B (2) abarbeiten
For Zeile_N = 1 To Zeile_N
strName = .Cells(Zeile_N, SpaName_N).Text
With wksData
'Name in Spalte A suchen - Spalte ggf anpassen
Set rngName = .Columns(SpaName_D).Find(what:=strName, LookIn:=xlValues, _
lookat:=xlWhole)
If rngName Is Nothing Then 'Name ist neu
'nächste freie Zeile in Spalte mit Namen
Zeile_D = .Cells(.Rows.Count, SpaName_D).End(xlUp).Row + 1
'Name am Ende der Liste anfügen
.Cells(Zeile_D, SpaName_D).Value = strName
.Cells(Zeile_D, 7).Value = Date 'Datum in Spalte G eintragen
Else
'Name ist in Liste vorhanden
Zeile_D = rngName.Row
.Cells(Zeile_D, 8).Value = Date 'Datum in Spalte H eintragen
End If
'Falls weitere Daten aus dem Blatt mit den exportierten Daten _
übertragen werden sollen, dann so
'.Cells(Zeile_D, 2).Value = wksNamen.Cells(Zeile_N, 3).Value 'C --> B
End With
Next Zeile_N
'Kontrolleintrag unter den Namen einfügen
Zeile_N = .Cells(.Rows.Count, SpaName_N).End(xlUp).Row + 1
.Cells(Zeile_N, SpaName_N).Value = "Uebertragen am" & Format(Date, "YYYY-MM-DD")
End If
End With
End Sub