Zeilen mit Wert X kopieren

Sebastian · 2017-08-28T06:52:34+00:00

Hi zusammen, ihr habt mir schon so oft erfolgreich geholfen. Vielleicht ja auch hier :) In Tabelle 1 (Report) kann in Spallte K (17-1500) über eine Formel das Wort "schlecht" ausgegeben werden. Ich würde gerne alle Zeilen in denen "schlecht" in Spallte K vorkommt, untereinander in Tabelle 2 (Fehlertabelle) kopieren. Am besten ab Spallte C und ab Zeile 17. Schon mal vielen Dank

Hi,
und hier der Code für den Blattschutz:

Sub Kopieren()
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim strSearch As String
Dim strPassword As String
Dim searchCol As Integer
'________________________________________ anpassen
Set wksQuelle = Worksheets("Report")
Set wksZiel = Worksheets("Fehlertabelle")
strSearch = "schlecht"
strPassword = ""
searchCol = 11 'Spalte K
'________________________________________
Application.ScreenUpdating = False
wksZiel.Unprotect Password:=strPassword
With wksQuelle
.Unprotect Password:=strPassword
.Cells.AutoFilter Field:=searchCol, Criteria1:=strSearch
.Range("A17").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wksZiel.Range("C17")
.AutoFilterMode = False
.Protect Password:=strPassword
End With
wksZiel.Protect Password:=strPassword
Set wksQuelle = Nothing
Set wksZiel = Nothing
End Sub

Die andere Frage hattest Du ja noch nicht beantwortet ...
Gruß
Klaus

Hallo Sebastian,
keine Ahnung, warum bei Dir der Code nicht funktioniert. Bei mir läuft er.
Vielleicht ist die Syntax bei Office 365 eine andere (habe noch ein altes Excel).
Probier mal diesen Code:

Sub Kopieren()
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim strSearch As String
Dim strPassword As String
'________________________________________ anpassen
Set wksQuelle = Worksheets("Report")
Set wksZiel = Worksheets("Fehlertabelle")
strSearch = "schlecht"
strPassword = ""
'________________________________________
Dim i As Long
Dim firstRow As Long
Dim lastRow As Long
Dim lastCol As Integer
firstRow = 17
lastRow = wksQuelle.Cells(Rows.Count, "A").End(xlUp).Row
lastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
wksZiel.Unprotect Password:=strPassword
With wksQuelle
.Unprotect Password:=strPassword
For i = 17 To lastRow
If .Range("K" & i) = strSearch Then
.Range(.Cells(i, 1), .Cells(i, lastCol)).Copy wksZiel.Range("C" & firstRow)
firstRow = firstRow + 1
End If
Next i
.Protect Password:=strPassword
End With
wksZiel.Protect Password:=strPassword
Set wksQuelle = Nothing
Set wksZiel = Nothing
End Sub

Klappt's ?
Gruß Klaus

Forumthread: Zeilen mit Wert X kopieren

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Zeilen mit Wert X kopieren

Forumthread: Zeilen mit Wert X kopieren

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread