从多个文件中复制单元格 J1 并粘贴到主文件的列中答案

【问题标题】：Copy cell J1 from multiple files and paste into column of masterfile从多个文件中复制单元格 J1 并粘贴到主文件的列中
【发布时间】：2015-06-01 12:22:08
【问题描述】：

我目前有这段代码，它将从文件夹中获取文件，打开每个文件，将其名称打印到我的“主文件”的第一列中，关闭它并循环遍历整个文件夹。

在每个打开的文件中，单元格 J1 中的信息我想复制并粘贴到“主文件”的第 3 列中。该代码有效，但只会一遍又一遍地将所需信息从 J1 粘贴到 C2 中，因此信息会不断被覆盖。我需要向下递增列表，以便将来自 J1 的信息打印到与文件名相同的行中。

有什么想法吗？

Sub LoopThroughDirectory()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim MyFolder As String
    Dim Sht As Worksheet
    Dim i As Integer

    MyFolder = "C:\Users\trembos\Documents\TDS\progress\"

Set Sht = ActiveSheet

    '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" And LCase(Left(Right(objFile.Name, 4), 3)) <> "xls" Then
        Else
            'print file name
            Sht.Cells(i + 1, 1) = objFile.Name
            i = i + 1
            Workbooks.Open fileName:=MyFolder & objFile.Name
        End If
        'Get TDS name of open file
        Dim NewWorkbook As Workbook
        Set NewWorkbook = Workbooks.Open(fileName:=MyFolder & objFile.Name)

        Range("J1").Select
        Selection.Copy
        Windows("masterfile.xlsm").Activate
        '
        '
        ' BELOW COMMENT NEEDS TO BE CHANGED TO INCREMENTING VALUES
        Range("D2").Select
        ActiveSheet.Paste
        NewWorkbook.Close
    Next objFile


End Sub

【问题讨论】：

要查找错误，请在第一行添加断点并使用Step Into (F8) 逐行移动。错误将在导致它的线路上触发。测试后报告该信息（编辑问题）。一种可能性是您正在使用Sht.Cells，如果Worksheet 真的是Chart，它将失败。
@Byron 谢谢！我在玩完文字后回来报告。对新问题有何建议？
此时，您的问题已进入本站How do I copy from [somewhere] and paste to [somewhere] 上百题的领域。我会环顾其中一些问题以获得一般性建议。特别是对于这段代码，为什么不在Else 中复制/粘贴内容，然后再增加i？然后您可以使用Cells(i+1,2) 粘贴到文件名旁边。也不清楚为什么要打开文件两次。
我不想打开文件两次。为了解决这个问题，我将在 End If 之前的 else 部分下输入新的复制/粘贴代码，并从 Sht.Cells(i+1, 2) 增加它？
@Byron 那是修复它的好方法吗？

标签： vba excel copy paste

【解决方案1】：

我对您的代码进行了一些修改，它显示了您需要的结果。
请注意，如果您的文件夹有其他文件扩展名，您的宏可能会损坏。
您可以使用以下代码来提高此宏的性能：
Application.ScreenUpdating = False

Option Explicit

Dim MyMasterWorkbook As Workbook
Dim MyDataWorkbook As Workbook
Dim MyMasterWorksheet As Worksheet
Dim MyDataWorksheet As Worksheet

Sub LoopThroughDirectory()

Set MyMasterWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyMasterWorksheet = MyMasterWorkbook.ActiveSheet

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim MyDataFolder As String
Dim MyFilePointer As Byte

MyDataFolder = "C:\Users\lengkgan\Desktop\Testing\"
MyFilePointer = 1

'create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'get the data folder object
Set objFolder = objFSO.GetFolder(MyDataFolder)

'loop through directory file and print names
For Each objFile In objFolder.Files

    If LCase(Right(objFile.Name, 3)) <> "xls" And LCase(Left(Right(objFile.Name, 4), 3)) <> "xls" Then
    Else
        'print file name
        MyMasterWorksheet.Cells(MyFilePointer + 1, 1) = objFile.Name
        MyFilePointer = MyFilePointer + 1
        Workbooks.Open Filename:=MyDataFolder & objFile.Name
    End If

'Get TDS name of open file
Set MyDataWorkbook = Workbooks.Open(Filename:=MyDataFolder & objFile.Name)
Set MyDataWorksheet = MyDataWorkbook.ActiveSheet

'Get the value of J1
MyMasterWorksheet.Range("C" & MyFilePointer).Value = MyDataWorksheet.Range("J1").Value

'close the workbook without saving it
MyDataWorkbook.Close (False)
Next objFile
End Sub

【讨论】：

keong，我强烈建议您开始使用 Long 而不是 Byte，Byte 限制为 255，如果文件夹中的文件超过 255 个会怎样？代码将因溢出错误而崩溃。整数通常会更好，但在 VBA 中它是多余的，并且有据可查的是 Long 是要走的路。
没有问题，希望对您有所帮助:)。不过，我确实建议阅读 VBA 和 Integer，阅读它是如何处理它的以及为什么我们应该使用 long 来代替它是非常有趣的（即使旧学校的编码器被教过）
嗨，Dan，我确实想到了关于将变量类型变暗的事情。我想知道整数与长相比是否已经绰绰有余？你不觉得声明变量 as long 会过度分配资源吗？
作为一名程序员，是的，我们被教导要使用尽可能少的内存，并且只使用需要的内存，但在 VBA 中不行。这将为您提供完整的解释。别担心，这是每个人都会掉入的陷阱，我花了很长时间才知道:) stackoverflow.com/questions/26409117/…
谢谢你，这消除了我的疑虑。你太专业了再次，非常感谢。

【解决方案2】：

如果文件名一致，即“Sheet1”，您可以在不打开文件的情况下执行此操作：

Sub LoopThroughDirectory()
    Dim objFSO As Object, objFolder As Object, objFile As Object, MyFolder As String, Sht As Worksheet
    MyFolder = "C:\Users\trembos\Documents\TDS\progress\"
    Set Sht = ActiveSheet
    'create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'get the folder object
    Set objFolder = objFSO.GetFolder(MyFolder)
    'loop through directory file and print names
    For Each objFile In objFolder.Files
        If Not LCase(Right(objFile.Name, 3)) <> "xls" And Not LCase(Left(Right(objFile.Name, 4), 3)) <> "xls" Then
            'print file name
            Sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Formula = objFile.Name
            Sht.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Formula = ExecuteExcel4Macro("'" & MyFolder & objFile.Name & "Sheet1'!R1C10") 'This reads from a closed file
        End If
    Next objFile
End Sub

【讨论】：

【解决方案3】：

这是有效的解决方案：

'print J1 values to Column 4 of masterfile
        With WB
            For Each ws In .Worksheets
                StartSht.Cells(i + 1, 1) = objFile.Name
                With ws
                    .Range("J1").Copy StartSht.Cells(i + 1, 4)
                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

【讨论】：