Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bereich kopieren, wenn Felder nicht leer

Bereich kopieren, wenn Felder nicht leer
15.05.2018 16:07:12
Peter
Hallo Excel-Spezialisten,
in der angehängten Datei möchte ich immer dann, wenn in den Spalten A, J und K ein wert steht, den zugehörigen Bereich in die Tabelle 2 verschieben. Der Bereich geht immer bis eine Zeile oberhalb der nächsten Materialnummer und bis Spalte "O". Im Beispiel sollen die beiden gelben Bereiche in Tabelle 2 verschoben werden, also A10 bis O12 und A15 bis O16.
Kann mir bitte jemand den Code erstellen für die Abfrage auf den jeweiligen Bereich.
Den "kleinen" Rest bekomme ich selbst hin.
Grüße und besten Dank im Voraus.
Peter
https://www.herber.de/bbs/user/121621.xlsx

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereich kopieren, wenn Felder nicht leer
15.05.2018 16:10:54
Hajo_Zi
Hallo Peter,
das geht nicht, da eine XLSX Datei kein Makro enthalten kann.
Ich sehe keinen Grund eine Datei 2x zu speichern. Ich führe keine Liste unter welchem Dateinamen ich die Datei gespeichert habe.

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
AW: Bereich kopieren, wenn Felder nicht leer
15.05.2018 16:26:27
Peter
Hallo Hajo,
die Datei soll nur ein Beispiel zur Veranschaulichung sein. XLSM-Dateien werden aber von vielen nicht geöffnet wegen dem Risiko, daher eine XLSX-Datei im Anhang. Ich kann auch gerne eine XLSM-Datei anhängen, wenn das gewünscht ist.
Hoffe trotzdem, dass mir jemand beim VBA-Code für die Abfrage behilflich sein kann.
Gruß Peter
Anzeige
AW: Bereich kopieren, wenn Felder nicht leer
15.05.2018 17:13:41
Pascal
Hallo Peter,
versuch es mal so:
Sub BereichKopieren()
Dim intZeile As Integer, intSpalte As Integer
Dim blKopieren As Boolean
Dim intZeileBereich As Integer, intZeileTabelle2 As Integer
With Tabelle1
For intZeile = 4 To .UsedRange.Rows.Count
If Not .Cells(intZeile, 1).Value = "" Then
blKopieren = True
For intSpalte = 10 To 12
If .Cells(intZeile, intSpalte).Value = "" Then blKopieren = False
Next intSpalte
If blKopieren = True Then
intZeileBereich = intZeile
Do Until .Cells(intZeileBereich, 1).Value  ""
intZeileBereich = intZeileBereich + 1
Loop
.Range(.Cells(intZeile, 1), .Cells(intZeileBereich, 15)).Copy
'Jetzt angeben wo die Daten hin sollen
intZeileTabelle2 = Tabelle2.UsedRange.Rows.Count
Tabelle2.Cells(intZeileTabelle2, 1).PasteSpecial xlPasteAll
End If
End If
Next intZeile
End With
End Sub
Gruß Pascal
Anzeige
AW: Bereich kopieren, wenn Felder nicht leer
16.05.2018 11:43:17
Peter
Hallo Pascal, erstmals besten Dank für Deine Unterstützung. Habe noch eine kleine Anpassung vorgenommen, so dass nicht nur die eine Zeile, sondern der Bereich kopiert wird.
Aber die Do-Schleife findet kein Ende (außer ich setze einen Punkt, ist aber unschön). Wie kann man der Do-Anweisung mitgeben, dass diese nur bis zum UsedRange.Rows.Count laufen soll ?
Wäre Klasse, wenn Du oder ein anderer Helfer das Ende noch einbauen könnten.
Danke.
Grüße Peter
Sub BereichKopieren()
Dim intZeile As Integer, intSpalte As Integer
Dim blKopieren As Boolean
Dim intZeileBereich As Integer, intZeileTabelle2 As Integer
With Tabelle1
For intZeile = 4 To .UsedRange.Rows.Count
If Not .Cells(intZeile, 1).Value = "" Then
blKopieren = True
For intSpalte = 10 To 11
If .Cells(intZeile, intSpalte).Value = "" Then blKopieren = False
Next intSpalte
If blKopieren = True Then
intZeileBereich = intZeile
Do Until .Cells(intZeileBereich + 1, 1).Value  ""
intZeileBereich = intZeileBereich + 1
Loop
.Range(.Cells(intZeile, 1), .Cells(intZeileBereich, 15)).Copy
'Jetzt angeben wo die Daten hin sollen
intZeileTabelle2 = Tabelle2.UsedRange.Rows.Count
Tabelle2.Cells(intZeileTabelle2 + 1, 1).PasteSpecial xlPasteAll
End If
End If
Next intZeile
End With
End Sub

Anzeige
AW: Bereich kopieren, wenn Felder nicht leer
16.05.2018 21:26:01
Pascal
Hallo Peter,
hoppla, das habe ich nicht bedacht.
Du kannst in die Do Schleife noch folgendes eintragen:
If .Cells(intZeileBereich, 3).Value = "" Then Exit Do
Auf die usedrange zu überprüfen wäre in diesem Fall nicht geeignet, da dann der Rest der Tabelle (weil der Rahmen noch weiter geht) mit kopiert wird.
Gruß Pascal
Super. Danke Pascal
17.05.2018 10:31:12
Peter

353 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige