Hallo Siegfried,
hier mal die bearbeitete Datei: [url=
http://filehorst.de/d/cFDkyCIx]Download[/url]
Beachte, dass das Ausführen von Makros zu gelassen sein muss ([url=
http://www.excelbeispiele.de/]Anleitung[/url]).
Du brauchst nur die betreffende Woche in der Tabelle Tourenplanung einzutragen und dann den Button zu drücken. Dann wird automatisch auf die Woche gefiltert und die Daten werden übertragen. Vorher werden im Blatt eventuelle vorhandene Daten gelöscht. Die ausgeblendete Spalte in der Tabelle Tourenplanung wird ignoriert.
Teste mal, ob das Makro so funktioniert wie du dir das vorstellst.
Beachte bitte, dass wenn du die Tabellen umbenennst, das Makro entsprechend geändert werden muss.
Der Vollständigkeit halber hier das Makro (gehört in ein allgemeine Modul):
[code]Sub tourenplanung()
Dim arrTour() As Variant
Dim lngLZeile As Long
Dim lngLSpalte As Long
Dim lngWoche As Long
Dim lngFilter As Long
Dim lngZaehler As Long
Dim rngZelle As Range
Dim a As Long
Dim lngEinfZ As Long
Dim lngEinfS As Long
'Prüfen, ob in Zelle F7 etwas steht
If Worksheets("Tourenplanung").Range("F7") = "" Then
'falls Zelle leer ist, dann Fehlermeldung ausgeben
MsgBox "Achtung! Die Kalenderwoche ist leer! Die Verarbeitung wird abgebrochen!", 16, "Fehler - Abbruch"
'und Makro beenden
Exit Sub
Else
'anderfalls wird Woche der Tourenplanung eingelesen
lngWoche = Worksheets("Tourenplanung").Range("F7")
End If
With Worksheets("Kunden")
'Falls in Tabelle Kunden eine Filterung aktiv, diese aufheben
If .FilterMode Then .ShowAllData
'Letzte Zeile im Blatt ermitteln
lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row
'Letzte Spalte im Blatt ermitteln
lngLSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column
'und dann Filtern
.Range(.Cells(1, 1), .Cells(lngLZeile, lngLSpalte)).AutoFilter Field:=11, Criteria1:="=" & lngWoche
'und Anzahl der gefilterten Zellen feststellen
lngFilter = .Range(.Cells(2, 1), .Cells(lngLZeile, 1)).SpecialCells(xlCellTypeVisible).Count
'nun Array für das Einlesen der Daten redimensionieren
ReDim arrTour(lngFilter, 3)
'und Daten einlesen
For Each rngZelle In .Range(.Cells(2, 15), .Cells(lngLZeile, 15)).Cells.SpecialCells(xlCellTypeVisible)
lngZaehler = lngZaehler + 1
arrTour(lngZaehler, 0) = rngZelle.Value 'Tag
arrTour(lngZaehler, 1) = .Cells(rngZelle.Row, 4).Value 'Name
arrTour(lngZaehler, 2) = .Cells(rngZelle.Row, 5).Value 'Straße
arrTour(lngZaehler, 3) = .Cells(rngZelle.Row, 6).Value 'Ort
Next rngZelle
End With
With Worksheets("Tourenplanung")
'Im Arbeitblatt Kunden eventuell vorhandene Einträge löschen
.Range("B11:E21").ClearContents
.Range("K11:H21").ClearContents
.Range("B25:E35").ClearContents
.Range("K25:H35").ClearContents
.Range("B39:E49").ClearContents
.Range("K39:H49").ClearContents
'Daten in die einzelnen Tage schreiben
For a = 1 To lngZaehler
'Auswählen, wo Daten eingefügt werden sollen
Select Case arrTour(a, 0)
Case Is = "Mo"
lngEinfZ = 11 'erste potenzielle Einfügezeile
lngEinfS = 2 'erste Einfügespalte
Case Is = "Di"
lngEinfZ = 25
lngEinfS = 2
Case Is = "Mi"
lngEinfZ = 39
lngEinfS = 2
Case Is = "Do"
lngEinfZ = 11
lngEinfS = 8
Case Is = "Fr"
lngEinfZ = 25
lngEinfS = 8
End Select
'leere Zeile im Bereich suchen
For lngZeile = lngEinfZ To lngEinfZ + 10
If .Cells(lngZeile, lngEinfS) = "" Then
.Cells(lngZeile, lngEinfS) = arrTour(a, 1) 'Name in 1. Spalte
.Cells(lngZeile, lngEinfS + 2) = arrTour(a, 2) 'Straße in 3. Spalte (eine Spalte ausgeblendet)
.Cells(lngZeile, lngEinfS + 3) = arrTour(a, 3) 'Ort
Exit For
End If
Next lngZeile
Next a
End With
End Sub[/code]
Gruß
M.O.