Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1424to1428
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeilen nach Kriterium kopieren

Zeilen nach Kriterium kopieren
17.05.2015 21:43:05
Martin
Guten Abend,
ich habe an meiner Liste weitergearbeitet und bin wieder an eine grenze gestoßen.
Das Programm unten funktioniert.
In Zelle M4 wird ein Wert eingetragen, dieser wird dann in Spalte Q gesucht.
Wird der Wert gefunden, wird ein Teil der Zeile 4 (B4:K4) kopiert und rechts von dem gefundenen Wert eingefügt.
Folgendes möchte ich nun erreichen:
Statt nur einen Wert in Spalte M, werde ich 10 gleichzeitig eintragen (zB. M4, M6, M11, M14,...) und würde gerne alle automatisch nacheinander wie oben verarbeiten lassen. Also immer die Zeile in der der Wert steht (B:K) kopieren und dann einfügen Rechts von Q:Q.
Danke schon für jede Hilfe in diese Richtung.

Sub ZelleFinden()
Dim strAnlage As String, rngCell As Range
strAnlage = Range("M4")
Set rngCell = Columns("Q:Q").Find(strAnlage, lookat:=xlWhole, LookIn:=xlValues, MatchCase:= _
True)
If Not rngCell Is Nothing Then
Range("B4:K4").Copy
rngCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
MsgBox "Maschine nicht vorhanden"
End If
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen nach Kriterium kopieren
18.05.2015 04:34:58
Matthias
Hallo
Lass ne Schleife über Spalte("M") laufen, soweit Du es brauchst
In diesem Bsp. von Zeile 4 bis Zeile 14 (For x = 4 To 14)
Option Explicit
Sub ZelleFinden()
Dim strAnlage As String, rngCell As Range, x&
Application.ScreenUpdating = False
For x = 4 To 14
If Range("M" & x)  "" Then
strAnlage = Range("M" & x)
Set rngCell = Columns("Q:Q").Find(strAnlage, lookat:=xlWhole, LookIn:=xlValues, MatchCase:= _
True)
If Not rngCell Is Nothing Then
Range("B" & x & ":K" & x).Copy
rngCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End If
Next
End Sub
Gruß Matthias

Anzeige
AW: Zeilen nach Kriterium kopieren
18.05.2015 09:57:02
Martin
Hallo Matthias,
besten Dank für deine Hilfe, klappt super.
Gruß,
Martin

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige