Excel 将范围复制到另一张图纸

我是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

---

我想这可能就是你要找的东西。我在代码中添加了注释以帮助解释它

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

Sub-tgr（）
将wbDest设置为工作簿
将wsDest设置为工作表
变暗复制为范围
作为字符串的Dim-sFolder
将文件设置为字符串
暗淡的光线和长的一样
设置wbDest=ThisWorkbook'将信息复制到其中的工作簿
将wsDest=wbDest.Worksheets（“Sheet1”）设置为将信息复制到其中的工作表
sFolder=“C:\Test\””包含要从中复制的xlsx文件的文件夹路径
lRow=1'将信息复制到的起始行
'调整文件夹路径以确保其以\
如果正确（sFolder，1）“\”则sFolder=sFolder&“\”
'获取文件夹路径中的第一个.xlsx文件
sFile=Dir（sFolder&“*.xlsx”）
'开始循环遍历文件夹中的每个文件
当Len（sFile）>0时执行
'打开文件夹中的当前工作簿
带工作簿。打开（文件夹和文件）
'将A1:C3中的公式仅从第一个工作表复制到目标工作表中
设置rCopy=.Sheets（1）.范围（“A1:C3”）
wsDest.Cells（lRow，“A”）.Resize（rCopy.Rows.Count，rCopy.Columns.Count）。Formula=rCopy.Formula
'按要复制的行数前进目标行
lRow=lRow+rCopy.Rows.Count
.Close False“关闭从文件夹打开的工作簿而不保存更改
以
sFile=Dir'前进到下一个文件
环
端接头

您要从每个工作簿中复制的范围始终是

A1:C3

吗？是的，但范围可能会改变，我想查找，但目前范围是doDo，您知道SQL吗？我不知道，抱歉，这太神奇了，谢谢Tigeravatar。一个问题，如果我只想要工作簿中的第一张工作表，而不是wb中的每张工作表？@Spock请参阅更新的答案。我删除了工作表循环，而只引用打开的工作簿的

工作表（1）

。你是救命恩人。非常感谢Tigeravatar如果文件在子文件夹中怎么办？对不起，我应该在我的原始帖子中提到这一点。你是说，你的主文件夹中有文件，而主文件夹中也有你需要查找文件的子文件夹？那么您需要的所有文件都分布在多个文件夹中？如果是这样的话，我建议问一个新问题，因为这与这个问题的意图大不相同。