Question

我是VBA的超级新手，我正在尝试将范围从封闭的Excel文件复制到活动工作簿中，而不会覆盖当前粘贴的范围。

这是在Excel 2016上。

Sub GetDataFromWbs()
    Dim wb As Workbook
    Dim ws As Worksheet
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldr = fso.Getfolder("C:\Path")
    Dim lastrow As Long

    For Each wbFile In fldr.Files
        If fso.GetExtensionName(wbFile.Name) = "xlsx" Then
            Set wb = Workbooks.Open(wbFile.Path)
            For Each ws In wb.Sheets
                ThisWorkbook.Activate
                Worksheets("Sheet1").Range("A1:D12").Formula = wb.Worksheets("Sheet1").Range("a1:c3").Formula  
                'here is where I would like to add +1 so my loop isn't overridden   
            Next 'ws
            wb.Close
        End If
    Next 'wbFile
End Sub

Answer 1

我认为您正在寻找类似这样的东西。我在代码中添加了注释，以帮助解释它。

Sub tgr()

    Dim wbDest As Workbook
    Dim wsDest As Worksheet
    Dim rCopy As Range
    Dim sFolder As String
    Dim sFile As String
    Dim lRow As Long

    Set wbDest = ThisWorkbook                   'The workbook where information will be copied into
    Set wsDest = wbDest.Worksheets("Sheet1")    'The worksheet where information will be copied into
    sFolder = "C:\Test\"                        'The folder path containing the xlsx files to copy from
    lRow = 1                                    'The starting row where information will be copied into

    'Adjust the folder path to ensure it ends with \
    If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"

    'Get the first .xlsx file in the folder path
    sFile = Dir(sFolder & "*.xlsx")

    'Begin loop through each file in the folder
    Do While Len(sFile) > 0

        'Open the current workbook in the folder
        With Workbooks.Open(sFolder & sFile)
            'Copy over the formulas from A1:C3 from only the first worksheet into the destination worksheet
            Set rCopy = .Sheets(1).Range("A1:C3")
            wsDest.Cells(lRow, "A").Resize(rCopy.Rows.Count, rCopy.Columns.Count).Formula = rCopy.Formula

            'Advance the destination row by the number of rows being copied over
            lRow = lRow + rCopy.Rows.Count

            .Close False    'Close the workbook that was opened from the folder without saving changes
        End With
        sFile = Dir 'Advance to the next file
    Loop

End Sub

将范围复制到另一张纸上

1 个答案: