Jetzt läuft es perfekt. Danke vielmals....
So siehts jetzt aus.
Sub TransferDetailedEstimate()
Dim clave As String
clave = "test"
If MsgBox("This command will owerwrite everything in this Sheet." & "Do you really want to transfer?", vbYesNo + vbQuestion) = vbYes Then
With Application
If (Join(.Transpose(Sheets("Detailed Estimate").Range("C4:C2000")), vbNullString) = Join(.Transpose(Sheets("Detailed Forecast").Range("C4:C2000")), vbNullString)) = True Then
Application.ScreenUpdating = False
Sheets("Detailed Forecast").Unprotect clave
Sheets("Detailed Estimate").Range("D4:D2000").Copy
Sheets("Detailed Forecast").Range("D4").PasteSpecial Paste:=xlPasteValues
Sheets("Detailed Estimate").Range("L4:L2000").Copy
Sheets("Detailed Forecast").Range("E4").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Detailed Forecast").Range("D4").Select
Sheets("Detailed Forecast").Protect clave, AllowDeletingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True, AllowFiltering:=True, UserInterfaceOnly:=True
Else: MsgBox "Number of lines is not the same. Please check and correct the number of lines.", vbCritical
End If
Application.ScreenUpdating = True
End With
End If
End Sub
|