VBA粘贴行为图像

只是有一个关于粘贴的快速问题。 我有一个脚本，将单个行导出到新创build的工作簿。 然而，问题是粘贴的值是以图像的forms存在的。 此外，评论被跳过。 我使用相同的代码粘贴到同一工作簿的其他工作表，并没有问题。

我似乎无法find原因。 任何帮助将不胜感激。

谢谢

Private Sub DC_1Month_Button_Click() 'Searches for crews working on MFDC (7343) and exports a new spreadsheet looking 3 weeks ahead for each person If MsgBox("Export DC individual schedules?") = vbNo Then Exit Sub End If On Error GoTo CleanFail Dim nowCol As Integer, lastCol As Integer, endCol As Integer, crewRow As Integer Dim masterSheet As Worksheet, newExcel As Object, newBook As Workbook, newSheet As Worksheet Dim startRow As Integer, endRow As Integer Dim currentName As String, currentProject As String startRow = 3 endRow = UsedRange.Row - 1 + UsedRange.Rows.count lastcoln = UsedRange.Column - 1 + UsedRange.Columns.count Set masterSheet = ThisWorkbook.Worksheets("Master Schedule") 'Find columns for today and date 3 weeks after nowCol = Range(Cells(2, 1), Cells(2, lastcoln)).Find(what:=Month(Date) & "/" & Day(Date) & "/" & Year(Date)).Column endCol = Range(Cells(2, 1), Cells(2, lastcoln)).Find(what:=Month(DateAdd("d", 30, Date)) & "/" & Day(DateAdd("d", 30, Date)) & "/" & Year(DateAdd("d", 30, Date))).Column 'Disable screen flashing while doing copying and exports Application.ScreenUpdating = False 'Loop through crew members For i = 3 To endRow 'Store current row's values currentName = Replace(ActiveSheet.Cells(i, 2).Value, "SA: ", "") currentProject = ActiveSheet.Cells(i, 3).Value 'Search the value from the Project column for the MFDC project number If InStr(1, currentProject, "7343") > 0 Then 'Load schedule template Set newExcel = CreateObject("Excel.Application") newExcel.DisplayAlerts = False newExcel.Workbooks.Open "\\VALGEOFS01\SurveyProjectManagers\304Schedule\Templates\DC_3Week_Template.xlsx" Set newBook = newExcel.Workbooks(1) Set newSheet = newBook.Worksheets(1) 'Copy and paste header rows masterSheet.Range(masterSheet.Cells(1, nowCol), masterSheet.Cells(2, endCol)).Copy 'Destination:=newSheet.Range("A1") Application.Wait (Now + TimeValue("0:00:01")) newSheet.Range(newSheet.Cells(1, 6), newSheet.Cells(1, endCol - 1)).PasteSpecial xlPasteValuesAndNumberFormats Application.CutCopyMode = False 'Copy and paste crew member's location masterSheet.Range(masterSheet.Cells(i, 2), masterSheet.Cells(i, 6)).Copy 'Destination:=newSheet.Range("A3") Application.Wait (Now + TimeValue("0:00:01")) newSheet.Range("A3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False 'Copy schedule data for crew member masterSheet.Range(masterSheet.Cells(i, nowCol), masterSheet.Cells(i, endCol)).Copy Application.Wait (Now + TimeValue("0:00:01")) newSheet.Cells(3, 6).PasteSpecial Paste:=xlPasteAll Application.CutCopyMode = False 'Save individual's schedule With newBook .Title = currentName & " MFDC Schedule" .SaveAs Filename:="\\VALGEOFS01\SurveyProjectManagers\304Schedule\MFDC Individual Schedules\" & currentName & " MFDC Schedule " & Format(Date, "yymmdd") & ".xlsx", AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges .Close (True) End With End If Next i CleanExit: MsgBox "Export complete" 'Restore normal screen updating Application.ScreenUpdating = True Exit Sub CleanFail: If Err.Number <> 0 Then Msg = "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & Err.Description MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext End If Resume CleanExit Resume End Sub