|
Hallo Matthias,
es macht keinen Sinn, wenn du mir erzählst, dass der Code in einen Fehler läuft. Dann solltest du mir schon auch noch erzählen, welche Codezeile den Fehler produziert.
Bei mir läuft der Code nicht in einen Fehler.
Ist aber auch egal, weil funktioniert so nicht, weil er die Daten aus der ausgeblendeten Spalte A nicht mitnimmt -habs grad getestet.
Dann so:
Option Explicit
Sub Übertrag_Montagefirma()
Dim loAnz As Long, loLetzte As Long
Dim raBereich As Range, raZelle As Range
Application.ScreenUpdating = False
With Worksheets("Montagefirma")
.Range("A1:AA" & .Cells(.Rows.Count, "A").End(xlUp).Row).ClearContents
End With
With Worksheets("Terminplan")
.Columns(1).Hidden = False
Set raBereich = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
For Each raZelle In raBereich.SpecialCells(xlCellTypeVisible)
If raZelle.Text = .Range("B7").Text Then
raZelle.EntireRow.SpecialCells(xlCellTypeVisible).Copy
loAnz = loAnz + 1
With Worksheets("Montagefirma")
loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row
If .Cells(1, "A") = "" Then loLetzte = 1
.Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteFormats
End With
End If
Next raZelle
.Columns(1).Hidden = True
End With
Application.CutCopyMode = True
MsgBox "Es wurden " & loAnz & " Sätze übertragen."
Set raBereich = Nothing
End Sub
Am Beginn des Makros Spalte A einbelnden und am Ende wieder ausblenden.
Gruß Werner
|