Alternative zu Select Befehlen

Hallo alle zusammen,
ich suche eine Alternative zu diesem Makro, welche ohne meine Select Verweise auskommt, da das Bildschirmflackern sehr nervig ist. Bei meinem Versuch mit With habe ich das Einfügen der Werte nicht mehr hinbekommen.
Hier mal die aktuelle funktionierende Version mit den Select Befehlen.
Vielen Dank schon mal für Eure Hilfe.

Sub Update_Project_1()
Set Wb = ThisWorkbook
Set WsQuelle = Wb.Worksheets("DP_Sources")
Set WsZiel = Wb.Worksheets("DataPool")
Set wAct = ActiveWorkbook
Set wProject = wAct.Sheets(2)
Application.ScreenUpdating = False
If WsQuelle.Range("D2").Value  "" Then
If WsQuelle.Range("F2").Value = "-" Or WsQuelle.Range("F2").Value = "" Then
WsQuelle.Range("D2").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets(2).Range("B5").Copy
WsQuelle.Range("A2").PasteSpecial xlValues
Sheets(2).Range("B3").Copy
WsQuelle.Range("B2").PasteSpecial xlValues
WsQuelle.Range("C2").Value = Mid(Sheets(2).Range("A18").Value, 13, 3)
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End If
WsQuelle.Range("F2") = Date
For i = 2000 To 2 Step -1
If WsQuelle.Cells(2, 1).Value = WsZiel.Cells(i, 1).Value Then
WsZiel.Cells(i, 1).EntireRow.Delete
End If
Next i
WsQuelle.Range("D2").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Import for GPS").Range("A5:S150").Copy
leereZeile = WsZiel.Cells(Rows.Count, 1).End(xlUp).Row + 1
WsZiel.Cells(leereZeile, 1).PasteSpecial xlValues
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Sheets("Report_HC-Chart").Select
Cells(1, 3).Select
End If
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
sorry, aber ich kann in dem code jetzt kein Überflüssiges Select finden.
am einfachsten vermeidest du das Bildschirmflackern, wenn du am Anfang ein Blatt selektierst, welches nicht beteiligt ist.
was sicherlich nervig ist, ist das Löschen der Zeilen, weil du hier jede Zeile einzeln löschst.

For i = 2000 To 2 Step -1
If WsQuelle.Cells(2, 1).Value = WsZiel.Cells(i, 1).Value Then
WsZiel.Cells(i, 1).EntireRow.Delete
End If
Next i

mit folgendem Code kannst du alle Zellen auf einmal löschen (wenn in Spalte A keine Formeln stehen)

With WsZiel.Columns(1)
.Replace WsQuelle.Cells(2, 1).Value, true, xlwhole
if Worksheetfunction.CountIf(.Cells, true) > 0 then
.SpecialCells(xlcelltypeconstants, 4).EntireRow.Delete
end if
end with

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread