Сбор данных из нескольких книг в основную книгу - пути из ячеек - PullRequest
0 голосов
/ 09 июля 2020

Я новичок в VBA, чтобы go легко угодить. Я пытаюсь настроить метод получения данных из диапазона ячеек (всегда одинаковых) и ввести эти данные в существующую главную книгу.

Проблема, с которой я столкнулся, связана с определенным путем для рабочих книг .

Ячейки F7: F37 содержат пути в виде «C: ...... [папка, содержащая книгу]» Я сколотил различные фрагменты кода, пытаясь заставить это работать. Любые отзывы или предложения будут очень приветствоваться.

Я попытался использовать

  • al oop, который циклически проходит через 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 

1 Ответ

0 голосов
/ 10 июля 2020

Итак, после некоторых проб и ошибок я нашел следующие работы - я оставлю их здесь для любых других новичков, которым нужна помощь с чем-то подобным.

Для дополнительного контекста - я учитель используя красный / желтый / зеленый конец трекеров topi c. Студенты заполняют свои 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...