VBA将行粘贴为图像

Question

只需快速了解一下粘贴问题。我有一个脚本将单个行导出到新创建的工作簿中。但是，问题是粘贴的值是图像的形式。此外，将跳过评论。我使用相同的代码粘贴到同一工作簿的其他工作表中，没有问题。

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

由于

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