将多个工作簿中的数据收集到主工作簿中 - 来自单元格的路径答案

【问题标题】：Gather Data from multiple workbooks into master workbook - paths from cells将多个工作簿中的数据收集到主工作簿中 - 来自单元格的路径
【发布时间】：2020-10-29 23:36:03
【问题描述】：

我是 VBA 的新手，请放轻松。我正在尝试设置一种从一系列单元格（始终相同）中获取数据的方法，并将这些数据输入到现有的主工作簿中。

我遇到的问题是工作簿的定义路径。

单元格 F7:F37 包含路径为“C:......[包含工作簿的文件夹]” 我拼凑了各种代码，试图让它工作。非常欢迎任何反馈或建议。

我尝试的是

通过 F6:F36 循环获取地址的循环
复制活动工作表上选定的范围
将范围粘贴到给定列中
使用新地址和列重复代码

Sub newhash()

'set parameters

 Application.ScreenUpdating = False
 Dim i As Integer, j As Integer
 Dim wkbDest As Workbook, wkbSource As Workbook
 Dim strPath As String
 
 Set wkbDest = ThisWorkbook
 Let j = 11
 strPath = Cells(i, 6).Value
 strExtension = Dir("*.xls*")


For i = 7 To 37

Do While strPath <> ""
        ChDir strPath
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Application.ScreenUpdating = True
        
        With wkbSource
               .Sheets("ALL RAGs").Range("E3:E236").Copy
               wkbDest.Sheets("RAG Raw Data").Cells(7, j).PasteSpecial xlPasteValues
                
                Application.CutCopyMode = False
                wkbSource.Close savechanges:=False
        
        End With
    strPath = Dir
    Loop
        
j = j + 1
Next i

Application.ScreenUpdating = True


End Sub

【问题讨论】：

标签： excel vba

【解决方案1】：

因此，经过反复试验，我发现了以下作品 - 我将把它留在这里，供其他需要类似帮助的新手使用。

添加上下文 - 我是一名教师，使用红色/琥珀色/绿色结尾的主题跟踪器。学生填写他们的 RAG，并将它们收集到一个主文件中

Private Sub GatherRAGS_Click()
 Application.ScreenUpdating = False 
 Dim j As Integer
 Let j = 11
 Dim wkbDest As Workbook, wkbSource As Workbook
 Dim Path As String
 Set wkbDest = ThisWorkbook
For i = 7 To 28
    Path = wkbDest.Sheets("RAG Raw Data").Cells(i, 6)
    Do While Path <> ""
            ChDir Path
            Extension = Dir("*.xls*")
            Set wkbSource = Workbooks.Open(Path & Extension)
            With wkbSource
                   .Sheets("ALL RAGs").Range("E3:E236").Copy
                   wkbDest.Sheets("RAG Raw Data").Cells(7, j).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                wkbSource.Close savechanges:=False
            Path = Dir
            End With 
    Loop
j = j + 1
Next i

Application.ScreenUpdating = True

End Sub

【讨论】：