PDA

View Full Version : Need to copy from all sheets from all workbooks



MicroE
05-17-2016, 03:54 AM
Hi I would really appreciate some help with Visual Basic.

I need to extract data from specific cells found in various sheets from multiple different excel files with the same structure.

For example, I need to copy cell A24 from a sheet called “Example1”, copy cell H4 from a sheet called “Example2”, copy a cell b4 from a sheet called “Example3”, etc. These sheets are all in one File. I then need to paste this data in a master file where each file has its own row. I then need to repeat this same process for my other files. If anyone knows some code or could assist me with this, I would really appreciate it.

I'm under pressure for this assignment and don't know how to complete it, i would be very grateful, in the meantime i will Keep looking for code.

snb
05-17-2016, 06:15 AM
Use the macrorecorder.

jolivanes
05-18-2016, 10:31 PM
You asked for an expert to help you. You got that in Post #2
If you want "not so expert" people to help you, you need to change the title from "VBA Expert help plz!" to something that means something like "Need to copy from all sheets from all workbooks" or something like it.

jolivanes
05-18-2016, 10:49 PM
In the meantime while you're changing the title and if I understand you right, you might try this on copies of your workbooks.
All Workbooks, incl Master, need to be in one and the same Folder. Only the "Master" workbook, which will have this code, will be open.
Change all references for the Sheet names, cell addresses and Folder name(s) as required.
Macro will get data from each workbook from Sheet "data" cell H7, "Sheet2" cell C4 and "Sheet3" Cell J11. Add/Change to your requirements.
All workbooks, except "Master", will need to have these Sheet names.
It puts the copied cell info into the Master in a Sheet named "report" in Columns J and on to the right. Change to your requirements.

Sub Get_Info_From_Cells()
Dim sPath As String
Dim sFil As String
Dim owb As Workbook
Dim twb As Workbook
Dim shArr, celArr, resArr(2) '<----- Change the 2 to the total cells to be copied in each sheet - 1
Dim j As Long
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
shArr = Array("data", "Sheet2", "Sheet3") '<----- Sheet names in each Workbook. Change as required
celArr = Array("H7", "C4", "J11") '<----- Cell addresses in each Sheet. Change as required
Set twb = ThisWorkbook
sPath = "C:\Temp\" '<----- Where all workbooks reside. Change as required
sFil = Dir(sPath & "*.xl*")
Do While sFil <> "" And sFil <> twb.Name
Set owb = Workbooks.Open(sPath & sFil)
With owb
For j = LBound(shArr) To UBound(shArr)
resArr(j) = Sheets(shArr(j)).Range(celArr(j)).Value
Next j
End With
twb.Sheets("report").Cells(Rows.Count, 10).End(xlUp).Offset(1).Resize(, 3) = Application.Transpose(Application.Transpose(resArr)) '<----- Change sheet name as required
owb.Close False 'Close no save
sFil = Dir
Loop
With Application
.Calculation = xlAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

SamT
05-18-2016, 11:15 PM
good idea. title is changed.