首页 > 解决方案 > VBA复制和粘贴不格式化

问题描述

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

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

谢谢你的帮助。

标签: excelvba

解决方案


.Copy您可以使用.PasteSpecial Paste:=xlPasteValues.

即类似的东西

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

为您的第一行。

或者您可以将单元格设置为等于您正在复制的范围,如您的问题评论中所建议的那样。

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

推荐阅读