Data Extraction multiple Sheets & Multiple Cells

5h1v

Board Regular
Joined
Oct 11, 2012
Messages
69
Hey,

I have tried to make a macro that I can select a folder and then export all the data from multiple sheets that are identical in layout to one sheet I have come up with this but I cant seem to get it to work, it is always sheet 4 and that's were I seem to be falling down, any ideas?
Code:
Sub FolderPicker_ExportData()

Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = ThisWorkbook
Dim sPath As String: Dim sFile As String
Dim L As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select one folder"
.AllowMultiSelect = False
If .Show = True Then
sPath = .SelectedItems(1) & "\"
sFile = Dir(sPath & "*.xls*")
If sFile <> "" Then


Application.ScreenUpdating = False
L = 1
Set ws = wb1.Sheets.Add(before:=wb1.Sheets(1))
Do Until sFile = ""
Set wb2 = Workbooks.Open(sPath & sFile)
ws.Cells(L, "A").Value = wb2.Sheets(4).Range("G3,a6,A8,c8,d8,g8,m8,n8,08,p8,q8,r8,s8,t8,u8").Value
ws.Cells(L, "B").Value = wb2.Sheets(4).Range("G3,a6,A9,c9,d9,g9,m9,n9,09,p9,q9,r9,s9,t9,u9").Value
ws.Cells(L, "C").Value = wb2.Sheets(4).Range("G3,a6,A10,c10,d10,g10,m10,n10,010,p10,q10,r10,s10,t10,u10").Value
ws.Cells(L, "D").Value = wb2.Sheets(4).Range("G3,a6,A11,c11,d11,g11,m11,n11,011,p11,q11,r11,s11,t11,u11").Value
ws.Cells(L, "E").Value = wb2.Sheets(4).Range("G3,a6,A12,c12,d12,g12,m12,n12,012,p12,q12,r12,s12,t12,u12").Value
ws.Cells(L, "F").Value = wb2.Sheets(4).Range("G3,a6,A13,c13,d13,g13,m13,n13,013,p13,q13,r13,s13,t13,u13").Value
ws.Cells(L, "G").Value = wb2.Sheets(4).Range("G3,a6,A14,c14,d14,g14,m14,n14,014,p14,q14,r14,s14,t14,u14").Value
ws.Cells(L, "H").Value = wb2.Sheets(4).Range("G3,a6,A15,c15,d15,g15,m15,n15,015,p15,q15,r15,s15,t15,u15").Value
ws.Cells(L, "I").Value = wb2.Sheets(4).Range("G3,a6,A16,c16,d16,g16,m16,n16,016,p16,q16,r16,s16,t16,u16").Value
ws.Cells(L, "J").Value = wb2.Sheets(4).Range("G3,a6,A17,c17,d17,g17,m17,n17,017,p17,q17,r17,s17,t17,u17").Value
L = L + 1


wb2.Close False
sFile = Dir()
Loop


Application.ScreenUpdating = True


Else
MsgBox "no files found"
End If
Else
MsgBox "Cancel"
End If
End With
ActiveWorkbook.Save
End Sub

Any help would be appreciated
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
2,006
What results are you getting as opposed to the results you are expecting?
 

5h1v

Board Regular
Joined
Oct 11, 2012
Messages
69
Its failing to run, the error message is:

run time error 1004

application defined or object defined error
 

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
2,006
I'm guessing you have option explicit and the variable 'ws' isn't declared:

Code:
[COLOR=#333333]Set [/COLOR][COLOR=#ff0000][B]ws[/B][/COLOR][COLOR=#333333] = wb1.Sheets.Add(before:=wb1.Sheets(1))[/COLOR]

No declaration of ws here unless it is declared elsewhere?

Code:
[COLOR=#333333]Sub FolderPicker_ExportData()[/COLOR]
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = ThisWorkbook
Dim sPath As String: Dim sFile As String
[COLOR=#333333]Dim L As Long[/COLOR]
 
Last edited:

5h1v

Board Regular
Joined
Oct 11, 2012
Messages
69

ADVERTISEMENT

No that is the entire thing, how would I go about fixing that?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,156
Office Version
  1. 365
Platform
  1. Windows
Couple of obvious problems spring to mind
1) You are trying to set the value of 1 cell to equal 15+ different cells. You can't do that.
2) In all your ranges rather than referring to O8, O9 etc you have 08,09 etc (ie zero not o)
 

5h1v

Board Regular
Joined
Oct 11, 2012
Messages
69

ADVERTISEMENT

I want the row to be those cells how can I change it so that it copies those cells to the relevant cell in a row.
 

5h1v

Board Regular
Joined
Oct 11, 2012
Messages
69
Thanks,

Replacing the 0s with o's at least got my data to generate.

I have got it so that it now pulls data from files, I would like each sheet to populate on the next row so in this instance i want it to populate A-J row 1 with the first lot of ranges, the second set of ranges would then populate the 2nd row etc etc so this should give me 10 rows of data per file.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,156
Office Version
  1. 365
Platform
  1. Windows
I don't understand what you are trying to do.
Currently you are trying to pull 15 separate cells into one cell.
 

5h1v

Board Regular
Joined
Oct 11, 2012
Messages
69
So I am trying to pull each set of ranges into one column so

I want this: G3,a6,A8,c8,d8,g8,m8,n8,o8,p8,q8,r8,s8,t8,u8 to populate the values into A1:A15 then the next set of ranges to populate B1:B15 etc etc

sorry if I am not being as helpful as I could be this is my first go at writing something myself.
 

Watch MrExcel Video

Forum statistics

Threads
1,132,703
Messages
5,654,825
Members
418,155
Latest member
demasisi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top