michelernqm
New Member
- Joined
- Jun 19, 2020
- Messages
- 11
- Office Version
- 365
- Platform
- Windows
I am new to VBA and I am getting hung up on trying to pull specific cells from multiple files into a master sheet. Example: I have a folder "C:\Users\me\main folder" that stores all the files needing referenced to "master" workbook. Each file in the "main folder" has the same layout with 4 tabs each. I need specific cells from each file, "Sheet 1" and the data carried over and written to the "master" workbook. I need "B22" cell from "Sheet 1" (from all workbooks in the "main folder") to be written in the master file cell "A1" while looping through the folder.
Sub ExtractCells()
Dim wb As Workbook
Dim ws As Worksheet
Dim MySheet As String
Dim r1 As Range
Dim i As Integer
Dim OpenWorkbook As Workbook
Dim OpenWorksheet As Worksheet
Dim SheetName As String
Dim Directory As String
Dim FileSpec As String
Dim MyFile As String
Directory = "C:\Users\me\main folder"
FileSpec = ".xlsx"
MyFile = Dir(Directory & "*" & FileSpec)
SheetName = "Sheet 1"
Set wb = ThisWorkbook
MySheet = "master"
Set ws = wb.Worksheets(MySheet)
Set r1 = ws.Range("A1")
i = 0
Do While MyFile <> ""
Set OpenWorkbook = Application.Workbooks.Open(Filename:=Directory & MyFile, ReadOnly:=True)
Set OpenWorksheet = OpenWorkbook.Worksheets(SheetName)
With OpenWorksheet
r1.Offset(i, 0).Value = .Range("B22").Value
End With
i = i + 1
MyFile = Dir
Loop
End Sub
Sub ExtractCells()
Dim wb As Workbook
Dim ws As Worksheet
Dim MySheet As String
Dim r1 As Range
Dim i As Integer
Dim OpenWorkbook As Workbook
Dim OpenWorksheet As Worksheet
Dim SheetName As String
Dim Directory As String
Dim FileSpec As String
Dim MyFile As String
Directory = "C:\Users\me\main folder"
FileSpec = ".xlsx"
MyFile = Dir(Directory & "*" & FileSpec)
SheetName = "Sheet 1"
Set wb = ThisWorkbook
MySheet = "master"
Set ws = wb.Worksheets(MySheet)
Set r1 = ws.Range("A1")
i = 0
Do While MyFile <> ""
Set OpenWorkbook = Application.Workbooks.Open(Filename:=Directory & MyFile, ReadOnly:=True)
Set OpenWorksheet = OpenWorkbook.Worksheets(SheetName)
With OpenWorksheet
r1.Offset(i, 0).Value = .Range("B22").Value
End With
i = i + 1
MyFile = Dir
Loop
End Sub