如何迭代循环遍历vba中的文件并将特定行一个接一个地打印到另一个工作表中

时间:2015-06-05 19:49:12

标签: excel vba excel-vba

我有几个需要处理的数据文件。我的代码使用宏来遍历每个数据文件 - 运行另一个宏来进行一些计算 - 将结果放在数据文件的顶行。 现在我希望每个文件的顶行中的特定列数据被发送到另一个文件 - 称为摘要,这样我就可以在仪表板中查看表格,其中包含有关该文件夹中所有文件的相关信息。

我的代码如下。在第一次操作数据时,我很难将数据添加到for循环内的新文件中。

Sub LoopThroughFiles(dirName)
    Dim currWorkBook As String
    'Dim i As Integer ' for going to next row in mastersheet

    currWorkBook = ActiveWorkbook.Name

    FolderName = dirName ' enter the folder where all the files are located
    If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator

    'make sure you change the file extension here appropriately - *.xls or *.xlsm

    Fname = Dir(FolderName & "*.xl*")

    'loop through the files
    Do While Len(Fname)
        'For i = 4 To 6 ' to advance rows in the master sheet where the data is collected
            With Workbooks.Open(FolderName & Fname)

                Call IceNucleationTempCalc

                ' this is where i want the data from the sheet to be moved to the present workbook and sheet1
                ' and put it in different rows.. right now, the i cant march through the rows and the data keeps
                ' copied over and over on B4-K4. i know it is doing exactly what i am asking to do, but how to loop thru
                ' columns inside this while loop? if i use the i=4-6 is there a way to say .Range(B4, i)?

                Sheets("IceNuclTemp").Range("F1:O1").Copy Destination:=Workbooks(currWorkBook).Sheets("Sheet1").Range("B4")

            End With
            Fname = Dir  ' go to the next file in the folder
        'Next i
    Loop

End Sub

我觉得这是一件简单的事情,我需要改变我访问这些细胞的方式,但我无法弄清楚..任何帮助将不胜感激。 谢谢, 苏雷什。

1 个答案:

答案 0 :(得分:0)

您需要获取对工作簿和工作表的一些引用,然后使用它们来复制您的范围。您需要做的就是使用行计数器在目标工作表上构建范围。像这样:

Sub LoopThroughFiles(dirName)
    Dim currWorkBook As Workbook
    Dim target As Worksheet

    Set currWorkBook = ActiveWorkbook
    Set target = currWorkBook.Sheets("Sheet1")

    FolderName = dirName
    If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xl*")

    Dim foundWorkBook As Workbook
    Dim i As Long
    'Start at row 4
    i = 4
    Do While Len(Fname)
        Set foundWorkBook = Workbooks.Open(FolderName & Fname)
        With foundWorkBook
            'Modify this to take a workbook reference instead of using the ActiveWorkbook.
            IceNucleationTempCalc foundWorkBook
            target.Range("B" & i & ":" & "K" & i).Value = _
                .Sheets("IceNuclTemp").Range("F1:O1").Value
            i = i + i
        End With
        Fname = Dir
    Loop

End Sub

请注意,您还必须修改IceNucleationTempCalc以将Workbook作为传递参数或提供某种类型的包装 - 从您的代码中可以看出它也使用了Active *对象。