问不带格式的VBA复制和粘贴

EN

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