Makro: Bereich auf freie Zellen untersuchen und Inhalt einfügen

Hallo an alle,
ich bräuchte einmal mehr Hilfe bei dem Erstellen eines Makros.
Ich möchte gerne aus dem Tabellenblatt "Übersicht" die Zelle A1 kopieren und in Tabellenblatt "Auftrag" im Bereich B2 bis C4 (also 9 mögliche Zellen) in die nächst freie Zelle einfügen lassen. Reihenfolge der Kontrolle soll dabei sein: B2, B3, B4, C2, C3; ...
Falls also B2, B3, B4 und C2 belegt sind, soll in C3 eingefügt werden.
Ich habe einige Lösungen gefunden, in denen ganze Zeilen oder eine Spalte auf Leere überprüft wird, leider aber nicht, wie man einen Bereich aus mehreren Zeilen und Spalten abfragt.
Es wäre super wenn ihr eine Lösung hättet.
Danke und Gruß,
Bernd

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 245215

Url: https://administrator.de/forum/makro-bereich-auf-freie-zellen-untersuchen-und-inhalt-einfuegen-245215.html

Ausgedruckt am: 23.12.2024 um 15:12 Uhr

2 Kommentare

Neuester Kommentar

Hallo Bernd,
für diesen Fall gibt es in der Range.Find-Methode den Parameter SearchOrder mit dem sich auch nach Spaltenreihenfolge suchen lässt:

Variante 1: (mit Range.Find)

Sub FindNextEmpty()
    dim ws1 as Worksheet, ws2 as Worksheet, c as Range
    Set ws1 = Worksheets("Übersicht")    'Übersichtstabelle  
    Set ws2 = Worksheets("Auftrag")       'Auftragstabelle  
    With ws2.Range("B2:C4")  
        Set c = .Find("", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)  
        If Not c Is Nothing Then
            c.Value = ws1.Range("A1").Value  
        End If
    End With
End Sub

Es geht zwar auch manuell mit zwei verschachtelten For-Schleifen über die Spalten und Zeilen, aber die Find-Methode ist hier, gerade wenn der Bereich der durchsucht werden soll größer ist, eleganter und schneller.

Falls es dich trotzdem interessieren sollte wie die manuelle Suche aussieht, hier noch diese Variante:

Variante 2: (mit verschachtelten FOR-Schleifen)

Sub FindNextEmpty()
    Dim ws1 As Worksheet, ws2 As Worksheet, c As Integer, r as Integer, rngSearch As Range
    Set ws1 = Worksheets("Übersicht")    'Übersichtstabelle  
    Set ws2 = Worksheets("Auftrag")       'Auftragstabelle  
    Set rngSearch = ws2.Range("B2:C4")  
    For c = 1 To rngSearch.Columns.Count
        For r = 1 To rngSearch.Rows.Count
            If rngSearch.Cells(r, c).Value = "" Then  
                rngSearch.Cells(r, c).Value = ws1.Range("A1").Value  
                Exit Sub
            End If
        Next
    Next
End Sub

Grüße Uwe