从多个工作簿收集数据到主工作簿-单元格路径

Question

我对VBA相当陌生，请放心。我试图设置一种方法，从一个单元格区域（总是相同的）获取数据，并将这些数据输入到现有的主工作簿中。

null

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 

Answer 1

因此，经过相当多的尝试和错误，我找到了以下工作-我将留在这里的任何其他新手谁需要类似的帮助。

为了增加上下文--我是一个使用红色/琥珀色/绿色主题跟踪器结尾的老师。学生们把他们的破布填好，然后把它们收集到一个主档案中

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