Question

我在文件夹中打开许多文件并尝试将数据[从F10复制到F列的末尾（某些行可能为空白），并从G10复制到列G的末尾（某些行可能为空白）]文件到一个名为“masterfile”的工作表，分别在第2列和第3列的标题下。我一直在尝试研究AdvancedFilter（）和CopyRange（），但无法使其正常工作。我对VBA没有经验，所以我很难弄清楚如何正确使用它们。有什么建议吗？

此代码当前打开文件夹中的每个文件，将每个文件的名称打印到主文件的第一列，并将打开文件的单元格J1中的信息打印到主文件的第4列。任何意见是极大的赞赏。我被困了一个星期。

Option Explicit

Sub LoopThroughDirectory()

    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
    Dim LastRow As Integer, erow As Integer
    Dim Height As Integer

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

    'location of the folder in which the desired TDS files are
    MyFolder = "C:\Users\trembos\Documents\TDS\progress\"

    Set StartSht = ActiveSheet
    Set StartSht = Workbooks("masterfile.xlsm").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, 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
        End If
    'move to next file
    Next objFile
    'turn screen updating back on
    'Application.ScreenUpdating = True

End Sub

Answer 1

问题是您无法从打开的工作表中复制文本？

要查找最后一行，我想使用：LastRow = ActiveSheet.UsedRange.Rows.Count，它会为您提供正在使用的行数。

然后，您可以执行：Range(cells(10, 6), cells(LastRow, 7)).copy并将其粘贴到主工作表中。（在这种情况下，对于F＆amp; G，列= 6＆amp; 7）

这将复制所有数据，甚至是空白单元格。如果您不想要空白，则Selection.PasteSpecial可以SkipBlanks:True

VBA - 打开多个文件，将数据从文件复制到主表

1 个答案: