|
So, jetzt habe ich es noch richtig gestellt.
Ich hatte das aufheben vom Passwort noch falsch gesetzt, was ich jetzt berichtigt habe.
Ich werde dann auch noch deine letzte Variannte ausprobieren.
Option Explicit
Option Compare Text
Sub Daten_uebertragen()
ActiveSheet.Unprotect Password:="xxxxxxxx"
Dim i As Long, iOutzeile As Long, iAnz As Integer
Application.ScreenUpdating = False
Worksheets("Datenbank").Range("A18:AM18").Copy
ActiveSheet.Unprotect Password:="xxxxxxxx"
Worksheets("Ziel").Activate
Range("A3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Worksheets("Ziel").Range("A4").Activate
iOutzeile = 4 ' Anfangsausgabezeile
With Sheets("Datenbank")
For i = 4 To .UsedRange.Rows.Count
If .Cells(i, "A").Value Like "x" Then
Sheets("Ziel").Rows(iOutzeile).Value = .Rows(i).Value
iOutzeile = iOutzeile + 1
iAnz = iAnz + 1
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox "Habe " & iAnz & IIf(iAnz = 1, " Satz", " Sätze") & " übertragen", vbInformation, "Daten übertragen"
ActiveSheet.Protect Password:="xxxxxxxx"
Tabelle7.Visible = xlSheetVisible
End Sub
|