0
votes

I'm fairly new to VBA to please go easy. I am trying to set up a method of grabbing data from a range of cells (always the same) and input this data into an existing master workbook.

The issue I am having is with the defined path for the workbooks.

Cells F7:F37 contain the paths as "C:......[folder containing the workbook]" I have cobbled together various bits of code in an attempt to get this to work. Any feedback or suggestions would be very welcomed.

What I have attempted is

  • a loop that cycles through F6:F36 for the address
  • copies the range selected on the active worksheet
  • pastes the range into a given column
  • repeats the code with a new address and column
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 
1

1 Answers

0
votes

So after quite some trial and error I've found the following works - I'll leave this here for any other newbies who need help with something similar.

For added context - I'm a teacher using Red/Amber/Green end of topic trackers. The students fill out their RAGs and they are collected into a master file

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