Data Extraction multiple Sheets & Multiple Cells

[5h1v]

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?

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

 

[gallen]

What results are you getting as opposed to the results you are expecting?

 

[5h1v]

Its failing to run, the error message is:

run time error 1004

application defined or object defined error

 

[gallen]

I'm guessing you have option explicit and the variable 'ws' isn't declared:

[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?

[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]

 

[5h1v]

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

 

[Fluff]

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]

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]

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]

I don't understand what you are trying to do.
Currently you are trying to pull 15 separate cells into one cell.

 

[5h1v]

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.