Supportnet / Forum / Tabellenkalkulation

Hallo, Beim letzten mal (https://supportnet.de/threads/1413277) hatte ich gefragt wie man aus einer großen Tabelle einen Teil bis zu einer bestimmten Zeile herauskopiert. JöKes Antwort war mir auch sehr hilfreich, bloß hab ich jetzt folgendes Problem: Wenn in der Spalte mit den Kalenderwochen (Tabelle1) diejenige fehlt, nach der laut Suchkriterium in der Zelle in Tabelle2 gesucht wird, kopiert er überhaupt nichts. Er sollte aber bis zu der Zeile kopieren die den nächstkleineren Wert aufweist. Bsp: [b]Suchkriterium[/b]: 5 [b]Tabelle:[/b] 1 Hubert klein 2 Berta groß 3 Anton schmal 6 Resi breit Er sollte jetzt alles bis zum Anton in eine andere Tabelle speichern. Code von JöKe: [b]Option Explicit Sub Kalenderwoche() Dim iKW As Integer, rngSuch As Range iKW = Sheets("Tabelle2").Range("A1") For Each rngSuch In Sheets("Tabelle1").Range("A1:A53") If rngSuch = iKW Then Sheets("Tabelle1").Rows("2:" & rngSuch.Row).Copy _ Destination:=Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next End Sub [/b]

Moin Mario,

so:

Option Explicit

Sub KalenderwocheII()
Dim iSuche As Integer
Dim iKW As Integer, rngSuch As Range
iKW = Sheets("Tabelle2").Range("A1")
iSuche = Application.WorksheetFunction.VLookup(iKW, Sheets("Tabelle1"). _
Range("A1:C53"), 1)
For Each rngSuch In Sheets("Tabelle1").Range("A1:A53")
If rngSuch = iSuche Then
Sheets("Tabelle1").Rows("2:" & rngSuch.Row).Copy _
Destination:=Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next
End Sub

Der Bereich Range("A1:C53") muss noch deiner Tabelle angepasst werden.

Gruß

JöKe

Vielen, vielen Dank

• Makro in Excel: Dynamische Liste kopieren
• 2 Tabellen übereinander/ergänzen
• Excel, dynamisch Zellen auswerten.
• Webseite inhalt kopieren und abspeichern?