copy paste ziel bleibt leer
12.10.2022 18:50:29
Mathias221
ich habe diesen Code am laufen wenn ich das Suchwort fix eingebe ohne userform hat es einwandfrei funktioniert aber mit meiner userform gibt er keine Zeile in der Ziel Datei aus obwohl er das Suchwort richtig findet und verwendet.
Sub Okay()
Stamm = Application.ActiveWorkbook.Name
Quelldatei = "xxxx.xlsm" 'Dateiname anpassen
Sheets("Dienstantritte").Unprotect "test"
Sheets("Dienstantritte").Cells.Range("A11:AJ46").Clear
strSuchwort = UserForm1.ComboBox1.Value
'strSuchwort = "Müller" Namen anpassen
Workbooks.Open Filename:="C:\user\" & Quelldatei 'Ablageort der Quelldatei anpassen
Assets = Array("Januar " & (Format(Now, "yy")), "Februar " & (Format(Now, "yy")), "März " & (Format(Now, "yy")), "April " & (Format(Now, "yy")) _
, "Mai " & (Format(Now, "yy")), "Juni " & (Format(Now, "yy")), "Juli " & (Format(Now, "yy")), "August " & (Format(Now, "yy")), "September " & (Format(Now, "yy")) _
, "Oktober " & (Format(Now, "yy")), "November " & (Format(Now, "yy")), "Dezember " & (Format(Now, "yy")))
On Error Resume Next
For Each Asset In Assets
Workbooks(Quelldatei).Sheets(Asset).Range("A10:AJ11").Copy ' Blatt/Bereich anpassen
Workbooks(Stamm).Sheets("Dienstantritte").Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteAll ' Blatt/Bereich anpassen
For Each rngZelle In Workbooks(Quelldatei).Sheets(Asset).Range("C:C")
If rngZelle = strSuchwort Then
rngZelle.EntireRow.Copy
Workbooks(Stamm).Sheets("Dienstantritte").Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteAll
End If
Next
Next
Application.CutCopyMode = False
Workbooks(Quelldatei).Close
Unload UserForm1
Sheets("Dienstantritte").Locked = True
Sheets("Dienstantritte").Range("A11:AJ46").Locked = False
Sheets("Dienstantritte").Protect "test"
End Sub