Anzeige
Archiv - Navigation
1480to1484
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

Excel Makro wenn Wert Zeile kopieren

Excel Makro wenn Wert Zeile kopieren
11.03.2016 08:44:14
tom91i
Hallo zusammen,
da ich mich erst seit kurzem mit dem Thema VBA beschäftige bin ich noch ziemlich unerfahren und würde dringend eure Hilfe benötigen.
Folgendes Problem. Ich möchte einen Makro erstellen welcher mir, wenn in der Spalte B der Wert "*********" und in Spalte C der Wert "2Y" erscheint, die ganze Zeile eins nach oben kopiert jedoch den Wert in Spalte B auf "xxxxxxxxx" abändert.
Kann mir hier jemand weiterhelfen?
Beste Grüße
Thomas

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 09:05:53
UweD
Nach oben kopiert
Meinst du
- Die Zeile darüber überschreiben, oder eine Zeile einfügen?
Gruß UweD

AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 09:10:16
tom91i
die ganze zeile kopieren und darüber einfügen (also eine neue Zeile) :)
Beste Grüße
Thomas

AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 09:28:41
UweD
so?

Dim i&, Bis&
With ActiveSheet
Bis = .Cells(Rows.Count, 3).End(xlUp).Row 'letzte Zeile der Spalte C
i = 2 'erste Zeile
Do Until i >= Bis
If .Cells(i, 2) = "*********" And .Cells(i, 3) = "2Y" Then
.Rows(i).Copy
.Rows(i).Insert Shift:=xlDown
Application.CutCopyMode = False
.Cells(i + 1, 2) = "xxxxxxxxx"
Bis = Bis + 1
End If
i = i + 1
Loop
End With
Gruß UweD

Anzeige
AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 11:41:06
tom91i
funtioniert super Danke Uwe hast mir den Tag wieder mal gerettet :D
Noch ne letzte Frage:
Ich versuche noch alle Zellen die Auf E "2Y" enthalten von A:M einzufärben. Aber irgendwie übernimmt er mir hier nichts wenn ich diesen Makro verwende:
Sub Makro5()
Dim rngCell As Range
For Each rngCell In Range("A:M")
If InStr(1, rngCell.Value, 5) = "2Y" Then
rngCell.Interior.ColorIndex = 45
Else
rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
End Sub

Beste Grüße
Thomas

AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 12:55:20
UweD
  If InStr(1, rngCell.Value, "2Y" >0 Then
Gruß UweD

Anzeige
AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 13:20:04
tom91i
Leider funktioniert er so auch nicht. Sicher dass es so passt?
Beste Grüße
Thomas

AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 13:25:56
UweD
Klammer vergessen
If InStr(1, rngCell.Value, "2Y") >0 Then

AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 13:36:44
tom91i
Danke schonmal :) funktioniert aber färbt nur die jeweilige Spalte und nicht den ganzen Bereich von A:M
Beste Grüße
Thomas

AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 13:47:07
tom91i
Also iwie hab ich hier generell nen Fehler drin :/
Nochmal die Situation:
Wenn Wert "2Y" in Spalte 5 dann Zeile A-M eingefärbt
Beste Grüße
Thomas

AW: Excel Makro wenn Wert Zeile kopieren
14.03.2016 09:39:09
UweD
So wie du das machst, durchsuchst du jede ZELLE in A:M nach 2Y und färbst die ein / bzw. setzt ohne
Also erst A1, B1, C2... M1 dann A2, B2 ....


So wird nur Spalte E durchsucht, und auch nur die Zellen, die Werte enthalten.
Dann wird in der Zeile der Bereich A:M eingefärbt.
Sub ddfsd()
Dim Zelle, RngCell
With ActiveSheet
Set RngCell = .Range("A:M")
For Each Zelle In .Columns(5).SpecialCells(xlCellTypeConstants, 3)
If InStr(1, Zelle.Value, "2Y") > 0 Then
Intersect(RngCell, Zelle.EntireRow).Interior.ColorIndex = 45
Else
Intersect(RngCell, Zelle.EntireRow).Interior.ColorIndex = xlNone
End If
Next
End With
End Sub
Gruß UweD

Anzeige
AW: Excel Makro wenn Wert Zeile kopieren
11.03.2016 10:57:46
UweD
Schneller

Dim Zelle
With ActiveSheet
For Each Zelle In .Columns(2).SpecialCells(xlCellTypeConstants, 3)
If Zelle.Value = "*********" And Zelle.Offset(0, 1).Value = "2Y" Then
Zelle.EntireRow.Copy
Zelle.EntireRow.Insert Shift:=xlDown
Application.CutCopyMode = False
Zelle.Offset(-1, 0).Value = "xxxxxxxxx"
End If
Next
Gruß UweD

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige