Question

我一直在寻找一种解决方案，我可以找到类似的解决方案，但是即使进行了调整和修正，我也无法使用任何解决方案。

我有一本名为“ Master.xlsb”的主工作簿，其中有一张名为“ Summary”的工作表。我在一个名为“ EmailAttachments”的文件夹中有189个文件的列表。

每个文件的行数都不同，因此我想遍历所有文件并从“ B7：B”和LastRow范围复制，并将数据粘贴到包含“ Master.xlsb”中数据的最后一行下面（随着粘贴数据的增加）。

此外，我想在A列中使用“'A7”'开头的文件名，以便我知道数据来自哪个文件。

谢谢。

编辑：

我设法使代码在下面工作：

Public Sub DataToSummary()
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim LastRowMaster As Long
Dim DataRowsMaster As Long
Dim LastRowSource As Long
Dim FileNameSource As String
Dim i As Integer, intValueToFind As Integer

Path = "C:\Example\Path\"
Filename = Dir(Path & "*.xlsx")

 Do While Len(Filename) > 0
    Set wbk = Workbooks.Open(Path & Filename)
                For i = 1 To 500
                If Cells(i, 1).Value = intValueToFind Then
                    GoTo Skip
                End If
                Next i
            LastRowSource = Cells(Rows.Count, 2).End(xlUp).Row
            DataRowsSource = LastRowSource - 6
            FileNameSource = Left(Filename, Len(Filename) - 5)
            Workbooks(Filename).Sheets(1).Range("B7:M" & LastRowSource).Copy

            Workbooks("Master.xlsb").Activate
            LastRowMaster = Cells(Rows.Count, 6).End(xlUp).Row
            ThisWorkbook.Sheets(1).Range("F" & LastRowMaster + 1).PasteSpecial xlPasteValues
            ThisWorkbook.Sheets(1).Range("B" & LastRowMaster + 1 & ":B" & LastRowMaster + DataRowsSource).Value = FileNameSource
            ThisWorkbook.Sheets(1).Range("C1:E1").Copy
            ThisWorkbook.Sheets(1).Range("C" & LastRowMaster + 1 & ":E" & LastRowMaster + DataRowsSource).PasteSpecial xlPasteFormulas
Skip:
    wbk.Close True
    Filename = Dir
Loop
End Sub

Answer 1

在这里，我找到了benmichae2用户的不错代码。用于循环浏览文件夹中的文件 Loop through files in a folder using VBA?

重用他/她的代码，我会做这样的事情：

显式选项

Sub LoopThroughFiles()

Dim firstEmptyRow As Long
Dim attachmentFolder As String, StrFile As String, filenameCriteria As String
Dim attachmentWorkBook As Workbook
Dim copyRngToArray As Variant

'# Define folder with attachments and set file extension
attachmentFolder = "C:\temp"
filenameCriteria = "xlsx"

'set
StrFile = Dir(attachmentFolder & "\*" & filenameCriteria)
Do While Len(StrFile) > 0
    Set attachmentWorkBook = Workbooks.Open(StrFile)

    With attachmentWorkBook.Worksheets(1)
        '#Copy the first column to array starting from "A7" to End of column
         copyRngToArray = .Range("A7:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With

    '#Thisworkbook is the file where this code is in actually your Master.xlsb file
    With ThisWorkbook.Worksheets(1)
        '#firsEmptyRow returns the first empty row in column B
        firstEmptyRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        '#paste file name to Column A
        .Range("A" & firstEmptyRow) = StrFile
        '#paste data in column B
        .Range("B" & firstEmptyRow).Resize(UBound(copyRngToArray)) = copyRngToArray
    End With

    Set attachmentWorkBook = Nothing
    StrFile = Dir
Loop

End Sub

将此代码粘贴到模块中，并检查一些示例excel文件

Answer 2

以下代码对我有用（更改示例路径）：

<input type="radio" name="shipping_method[0]" data-index="0" id="shipping_method_0_flat_rate11" value="flat_rate:11" class="shipping_method">
<input type="radio" name="shipping_method[0]" data-index="0" id="shipping_method_0_nova_poshta_shipping_method" value="nova_poshta_shipping_method" class="shipping_method">
<input type="radio" name="shipping_method[0]" data-index="0" id="shipping_method_0_flat_rate10" value="flat_rate:10" class="shipping_method">

VBA遍历文件夹中的文件并将变量范围复制/粘贴到主文件

2 个答案: