Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1292to1296
1292to1296
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Werte mit bestimmten Inhalt verschieben?

Forumthread: Werte mit bestimmten Inhalt verschieben?

Werte mit bestimmten Inhalt verschieben?
14.01.2013 14:14:22
Selma
Hallo Leute,
ich möchte in aktivem Arbeitsblatt ab Zeile 1 bis letzte benutzte Zelle der Spalte A per VBA folgendes erreichen:
Die Zellinhalte die "UTC 2" beinhalten sollen um eine Spalte nach rechts und eine Zeile nach oben verschoben werden.
Vorher:

Nachher:

Anbei die XLSX-Datei: https://www.herber.de/bbs/user/83385.xlsx
Wie mache ich das bitte?
Gruß,
Selma

Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte mit bestimmten Inhalt verschieben?
14.01.2013 14:25:37
Klaus
Hi,
in deinem Muster muss nicht nach "UTC 2" gesucht werden, es kann einfach jede zweite Zeile behandelt werden.
Option Explicit
Sub verschieben()
Dim lRow As Long
Dim iColIn As Integer
Dim iColOut As Integer
Dim rBereich As Range
iColIn = 1  'von Spalte A
iColOut = 2 'nach Spalte B
With ActiveSheet
lRow = .Cells(Rows.Count, iColIn).End(xlUp).Row
For Each rBereich In .Range(.Cells(1, iColIn), .Cells(lRow, iColIn))
If rBereich.Row Mod 2 = 0 Then
rBereich.Offset(-1, 1).Value = rBereich.Value
rBereich.Value = ""
End If
Next rBereich
End With
End Sub
Grüße,
Klaus M.vdT.

Anzeige
Lösung mit "like"
14.01.2013 14:33:03
Klaus
Hi nochmal,
falls in deiner Originaldatei nicht immer jede zweite Zelle verschoben wird, hier eine Version die tatsächlich auf den Zelleninhalt "*UTC 2*" prüft.
Option Explicit
Sub verschieben()
Dim lRow As Long
Dim iColIn As Integer
Dim iColOut As Integer
Dim rBereich As Range
iColIn = 1  'von Spalte A
iColOut = 2 'nach Spalte B
With ActiveSheet
lRow = .Cells(Rows.Count, iColIn).End(xlUp).Row
For Each rBereich In .Range(.Cells(1, iColIn), .Cells(lRow, iColIn))
If rBereich.Value Like "*UTC 2*" Then
rBereich.Offset(-1, 1).Value = rBereich.Value
rBereich.Value = ""
End If
Next rBereich
End With
End Sub
Grüße,
Klaus M.vdT.

Anzeige
AW: Lösung mit "like"
14.01.2013 17:19:10
Selma
Hallo Klaus M.vdT.,
vielen Dank, es funktioniert prima.
Gruß,
Selma

Danke für die Rückmeldung! owT.
15.01.2013 08:27:48
Klaus
.
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige