VBA Zelle löschen und nach oben verschieben
16.11.2016 11:33:02
Raimund
Habe folgendes Script.
Vom Blatt Data und Bereich I13:I1000 importiere ich es ins Blatt Verification Bereich Q8:Q1000.
Ferner setze ich auch eine bedingte Formatierung wenn im Blatt Verification und Bereich $K$8:$P$1000 wenn 2 Zellen befüllt sind und entferne ich alle Duplikate.
Nun das Problem.
Im Blatt Data und Bereich I13:I1000 habe ich eine Zelle die mit Sternchen (*************) befüllt ist und diese soll beim Import gelöscht werden und alles was drunter ist im Blatt Verivication und Bereich $K$8:$P$1000 nach oben verschoben werden.
Hoffe auf eine Lösung und bedanke mich im Voraus.
============================
Option Explicit
Sub Import_Verivication()
Dim lngLetzte As Long
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 6)), Cells(Rows.Count, 6).End(xlUp).Row, _
_
Rows.Count)
Dim Rng2Copy As Range, Rng2Paste As Range
Dim aWerte()
Set Rng2Copy = Sheets("Data").Range("I13:I1000" & lngLetzte)
Set Rng2Paste = Sheets("Verification").Range("Q8:Q1000" & lngLetzte)
aWerte() = Rng2Copy
Rng2Paste = aWerte()
ActiveSheet.Range("Q8:Q1000").RemoveDuplicates Columns:=1 ', Header:=xlYes
Range("$K$8:$P$1000").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=COUNTA($K8:$P8)>=2"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("M8").Select
End Sub