Makro, dass Formel kopiert und Werte einfügt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim lngR As Long If Target.Column = 4 Then If Target.Count = 1 Then On Error GoTo ERREXIT Application.EnableEvents = False lngR = Target.Row Cells(lngR, 2).FormulaR1C1 = Cells(1, 2).FormulaR1C1 Cells(lngR, 3).FormulaR1C1 = Cells(1, 3).FormulaR1C1 Cells(lngR, 6).FormulaR1C1 = Cells(1, 6).FormulaR1C1 Cells(lngR, 8).FormulaR1C1 = Cells(1, 8).FormulaR1C1 Cells(lngR, 9).FormulaR1C1 = Cells(1, 9).FormulaR1C1 Cells(lngR, 10).FormulaR1C1 = Cells(1, 10).FormulaR1C1 Cells(lngR, 11).FormulaR1C1 = Cells(1, 11).FormulaR1C1 Cells(lngR, 12).FormulaR1C1 = Cells(1, 12).FormulaR1C1 Rows(lngR).Copy Cells(lngR, 1).PasteSpecial xlPasteValues Application.CutCopyMode = False End If End If ERREXIT: Application.EnableEvents = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range, c As Range, z&, cc As Range, zf& Dim gefunden As Boolean If Target.Column = 7 And Target.Count = 1 Then If Target "" And Target.Offset(, -6) "" Then z = Target.Row gefunden = False Set cc = Range("A1:A" & z - 1).Find(Target.Offset(, -6).Value, _ Range("A1"), xlValues, xlWhole) If Not cc Is Nothing Then zf = cc.Row Do Set cc = Range("A1:A" & z - 1).FindNext(cc) If cc.Offset(, 6) = Target Then Target.Offset(, -2) = cc.Offset(, 4) '& " " & (cc.Offset(, 4).Address) gefunden = True End If Loop Until cc Is Nothing Or cc.Row = zf Or gefunden End If If Not gefunden Then Target.Offset(, -2).Value = "n.v." End If End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 And Target "" Then On Error GoTo ERREXIT Application.EnableEvents = False Select Case Target.Column Case 4: Call SpalteD(Target) Case 7: Call SpalteD(Target): Call SpalteG(Target) End Select End If ERREXIT: Application.EnableEvents = True End Sub Sub SpalteG(ByVal Target As Range) Dim r As Range, c As Range, z&, cc As Range, zf& Dim gefunden As Boolean If Target.Offset(, -6) "" Then z = Target.Row gefunden = False Set cc = Range("A1:A" & z - 1).Find(Target.Offset(, -6).Value, _ Range("A1"), xlValues, xlWhole) If Not cc Is Nothing Then zf = cc.Row Do Set cc = Range("A1:A" & z - 1).FindNext(cc) If cc.Offset(, 6) = Target Then Target.Offset(, -2) = cc.Offset(, 4) '& " " & (cc.Offset(, 4).Address) gefunden = True End If Loop Until cc Is Nothing Or cc.Row = zf Or gefunden End If If Not gefunden Then Target.Offset(, -2).Value = "n.v." End If End Sub Sub SpalteD(ByVal Target As Range) Dim lngR As Long lngR = Target.Row Cells(lngR, 2).FormulaR1C1 = Cells(1, 2).FormulaR1C1 Cells(lngR, 3).FormulaR1C1 = Cells(1, 3).FormulaR1C1 Cells(lngR, 6).FormulaR1C1 = Cells(1, 6).FormulaR1C1 Cells(lngR, 8).FormulaR1C1 = Cells(1, 8).FormulaR1C1 Cells(lngR, 9).FormulaR1C1 = Cells(1, 9).FormulaR1C1 Cells(lngR, 10).FormulaR1C1 = Cells(1, 10).FormulaR1C1 Cells(lngR, 11).FormulaR1C1 = Cells(1, 11).FormulaR1C1 Cells(lngR, 12).FormulaR1C1 = Cells(1, 12).FormulaR1C1 Rows(lngR).Copy Cells(lngR, 1).PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub

Hallo Rudi,
würdest du bitte nochmal nach dem Makro schaun, die Tests haben zwar soweit funktioniert, aber beim eigentlichen Arbeiten gibt es doch ein paar Probleme.
du siehst sicherlich, ich habe versucht aus Spalte D die Spalte E zu machen, war ein Fehler von mir in der Problembeschreibung.
Und ich habe in der Zeile

Case 7: Call SpalteG(Target): Call SpalteE(Target)

die Reihenfolge vertauscht, da das Makro Spalte G ja etwas in Spalte E schreibt.
Aber nun zu den beiden Problemen die ich habe,
ich kopiere in den Spalten E und G oft mal Texte in mehrere Zellen gleichzeitig, das meiste waren bislang 12 Zellen, das Makro funktioniert nur, wenn ich den Text jeweils einzeln kopiere.
dass ich einen Text in mehrere Zellen gleichzeitig kopiere, passiert auch in Spalte D, in dem Fall bekomme ich einen Laufzeitfehler 13, Typen unverträglich, und beim Debuggen wird die Zeile

If Target.Count = 1 And Target  "" Then

markiert. Obwohl das Makro doch eigentlich mit Spalte D nichts mehr zu tun haben dürfte.
Außerdem wärs super wenn nach dem Ausführen die Zelle ausgewählt wird in die ich zuvor etwas eingegeben habe, anstatt die ganze Zeile.
Gruß und danke für die erneute Hilfe
Jenny


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 And Target  "" Then
On Error GoTo ERREXIT
Application.EnableEvents = False
Select Case Target.Column
Case 5: Call SpalteE(Target)
Case 7: Call SpalteG(Target): Call SpalteE(Target)
End Select
End If
ERREXIT:
Application.EnableEvents = True
End Sub
Sub SpalteG(ByVal Target As Range)
Dim r As Range, c As Range, z&, cc As Range, zf&
Dim gefunden As Boolean
If Target.Offset(, -6)  "" Then
z = Target.Row
gefunden = False
Set cc = Range("A1:A" & z - 1).Find(Target.Offset(, -6).Value, _
Range("A1"), xlValues, xlWhole)
If Not cc Is Nothing Then
zf = cc.Row
Do
Set cc = Range("A1:A" & z - 1).FindNext(cc)
If cc.Offset(, 6) = Target Then
Target.Offset(, -2) = cc.Offset(, 4) '& " " & (cc.Offset(, 4).Address)
gefunden = True
End If
Loop Until cc Is Nothing Or cc.Row = zf Or gefunden
End If
If Not gefunden Then Target.Offset(, -2).Value = "n.v."
End If
End Sub
Sub SpalteE(ByVal Target As Range)
Dim lngR As Long
lngR = Target.Row
Cells(lngR, 2).FormulaR1C1 = Cells(1, 2).FormulaR1C1
Cells(lngR, 3).FormulaR1C1 = Cells(1, 3).FormulaR1C1
Cells(lngR, 6).FormulaR1C1 = Cells(1, 6).FormulaR1C1
Cells(lngR, 8).FormulaR1C1 = Cells(1, 8).FormulaR1C1
Cells(lngR, 9).FormulaR1C1 = Cells(1, 9).FormulaR1C1
Cells(lngR, 10).FormulaR1C1 = Cells(1, 10).FormulaR1C1
Cells(lngR, 11).FormulaR1C1 = Cells(1, 11).FormulaR1C1
Cells(lngR, 12).FormulaR1C1 = Cells(1, 12).FormulaR1C1
Rows(lngR).Copy
Cells(lngR, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 And Target "" Then On Error GoTo ERREXIT Application.EnableEvents = False Select Case Target.Column ' Case 5: Call SpalteE(Target) ' Case 7: Call SpalteG(Target): Call SpalteE(Target) Case 5: Call SpalteE(Target) Case 7: Call SpalteG(Target.Row): Call SpalteE(Target) End Select Target.Select ' neu ******************** End If ERREXIT: Application.EnableEvents = True End Sub Sub SpalteG(ByVal z&) ' Zeile des Target as long neu ********** Dim r As Range, c As Range, cc As Range, zf& Dim gefunden As Boolean If Range("A" & z) "" Then gefunden = False Set cc = Range("A1:A" & z - 1).Find(Range("A" & z), _ Range("A1"), xlValues, xlWhole) If Not cc Is Nothing Then zf = cc.Row Do Set cc = Range("A1:A" & z - 1).FindNext(cc) If cc.Offset(, 6) = Range("G" & z) Then Range("E" & z) = cc.Offset(, 4) gefunden = True End If Loop Until cc Is Nothing Or cc.Row = zf Or gefunden End If If Not gefunden Then Range("E" & z).Value = "n.v." End If End Sub

Beliebteste Forumthreads (12 Monate)

Makro, dass Formel kopiert und Werte einfügt

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread