Question

我有此代码，但是它将原始文档中的单元格格式粘贴到主文件中，请问如何从输出中删除格式？

Option Explicit

Sub CopyPastefiles()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim MyFolder As String
    Dim StartSht As Worksheet, ws As Worksheet
    Dim WB As Workbook
    Dim i As Integer

    'turn screen updating off - makes program faster
    'Application.ScreenUpdating = False

    'location of the folder in which the desired TDS files are
    MyFolder = "U:\Documents\DeleteMe\Sycle\"

    Set StartSht = ActiveSheet
    Set StartSht = Workbooks("masterfile.xlsx").Sheets("Sheet1")

    'create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'get the folder object
    Set objFolder = objFSO.GetFolder(MyFolder)
    i = 1

    'loop through directory file and print names
    For Each objFile In objFolder.Files
        If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then
            'print file name to Column 1
            Workbooks.Open Filename:=MyFolder & objFile.Name
            Set WB = ActiveWorkbook
            'print TOOLING DATA SHEET(TDS): values to Column 2
            With WB
                For Each ws In .Worksheets
                    StartSht.Cells(i + 1, 10) = objFile.Name
                    With ws
                        .Range("e6").Copy StartSht.Cells(i + 1, 4)
                        .Range("e7").Copy StartSht.Cells(i + 1, 5)
                        .Range("e8").Copy StartSht.Cells(i + 1, 6)
                        
                    End With
                    
                    i = i + 1
                'move to next file
                Next ws
                'close, do not save any changes to the opened files
                .Close SaveChanges:=False
            End With
        End If
    'move to next file
    Next objFile
    
    'turn screen updating back on
    'Application.ScreenUpdating = True

End Sub

感谢您的帮助。

Answer 1

可以使用.Copy代替使用.PasteSpecial Paste:=xlPasteValues直接将值粘贴到目标中。

即像

.Range("e6").Copy
StartSht.Cells(i + 1, 4).PasteSpecial Paste:=xlPasteValues

第一行。

或者您也可以按照问题注释中的建议，将单元格设置为要复制的范围。

.StartSht.Cells(i + 1, 4) = .Range("E6")

VBA复制和粘贴而无需格式化

1 个答案: