Office: (Office 2013) Hilfestellung zu einem Makro

Hallo Liebe Helfer/innen,

ich habe beim durchsuchen des Forums ein Makro gefunden das ich benoetige bzw. das mich anspricht.
Leider ist in dem Makro die Funktion "ausschneiden (cut)" und "einfuegen" hinterlegt. Das gute daran ist ja das das ausgeschnittene Automatisch geloescht wird. Nur beim Einfuegen wird die Funktion die in einer Zelle steht mit eingefuegt, das ist dabei schlecht da ich nur den "Wert" der Funktion brauche und nicht die Funktion an sich selbst.

Kurze Beschreibung meiner Excel:
Ich habe eine Projektplan excel in der mehrer Projekte hinterlegt sind. Mit Hilfe einer Funktion werden Termindaten in die entsprechende Zellen automatisch eingefuegt. z.b. ein "x" steht in Spalte "a" und Zeile "b" aus diesem Schnittpunkt wird der Tag aus der Spalte in die passende Zeile eingefuegt.
Hier einfach mal die Funktion:" =INDIREKT(ADRESSE(6;SPALTE(INDEX($Q14:$PT14;(VERGLEICH("WE";$Q14:$PT14;0)))))) "

Anschließend soll mit folgenden Makro gearbeitet werden. Nur das beim einfuegen der "Wert" eingefuegt werden soll und nicht der "Inhalt (oben aufgezeichnetete Funktion)".


Makro:

Option Explicit

Public Sub ZeilenFilternUndVerschieben()
Dim loLetzte As Long
Dim loLetzteTab3 As Long
Dim loAnzahl As Long
Dim loCounter As Long
Dim strKriterium1 As String
Dim strKriterium2 As String

loAnzahl = 0
strKriterium1 = "x" ' bezieht sich auf Spalte Z (Spaltennummer 26)


With ThisWorkbook.Worksheets("Tabelle3")
loLetzteTab3 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
End With

With Me
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
For loCounter = 1 To loLetzte
If .Cells(loCounter, 26).Value = strKriterium1 Then
loAnzahl = loAnzahl + 1
End If
Next loCounter
For loCounter = loLetzte To 1 Step -1
If .Cells(loCounter, 26).Value = strKriterium1 Then
.Rows(loCounter).EntireRow.Cut Destination:=ThisWorkbook.Worksheets("Tabelle3").Rows(loLetzteTab3 + loAnzahl)
.Rows(loCounter).EntireRow.Delete shift:=xlUp
loAnzahl = loAnzahl - 1
End If
Next loCounter
End With

End Sub


Wenn jemand ein besseres Makro hat das mein Problem behebt wuerde ich mich ueber eine Rueckmeldung freuen.

Gruß,
Denis

 

Hi Denis,

ungetestet: versuche es mal, indem du die Zeile

Code:

.Rows(loCounter).EntireRow.Cut Destination:=ThisWorkbook.Worksheets("Tabelle3").Rows(loLetzteTab3 + loAnzahl)

durch diese beiden Zeilen ersetzt

Code:

.Rows(loCounter).EntireRow.Copy
ThisWorkbook.Worksheets("Tabelle3").Rows(loLetzteTab3 + loAnzahl).PasteSpecial Paste:=xlValues

Bis später,
Karin

 

Hallo Karin,

vielen Dank für die schnelle Rückmeldung!!

Das Makro funktioniert nun wie gewünscht!

Vielen Dank nochmals !

Gruß,
Denis