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

 

[Fluff]

My pleasure & thanks for the feedback

 

[5h1v]

Sorry I want to take the following and add in an extra column at the stat so "A" this would be cell D4 on each one of my sheets, would the following work;

   Application.ScreenUpdating = False
   L = 1
   Do Until sFile = ""
      Set wb2 = Workbooks.Open(sPath & sFile)
      Ary = Application.Index(wb2.Sheets(4).Range("A8:U17").Value, Evaluate("row(1:10)"), Array(1, 3, 4, 7, 13, 14, 15, 16, 17, 18, 19, 20, 21))
      Ws.Range("A" & L).Resize(10).Value = wb2.Sheets(4).Range("D4").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("G3").Value
      Ws.Range("C" & L).Resize(10).Value = wb2.Sheets(4).Range("A6").Value
      Ws.Range("D" & L).Resize(10, 13).Value = Ary
      L = L + 10

Thanks Again

 

[Fluff]

I should think so, the best way to find out, is to try it.

 

[5h1v]

One last question, I want to have column M-U on a new line with the data before it remaining the same, how would I do that?

 

[Fluff]

I don't understand there is only data going into cols A:P

 

[5h1v]

Let me try and explain further - sorry

Currently this pulls the data in one row

Ary = Application.Index(wb2.Sheets(4).Range("A8:U17").Value, Evaluate("row(1:10)"), Array(1, 3, 4, 7, 13, 14, 15, 16, 17, 18, 19, 20, 21)) Ws.Range("A" & L).Resize(10).Value = wb2.Sheets(4).Range("D3").Value
Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("G3").Value
Ws.Range("C" & L).Resize(10).Value = wb2.Sheets(4).Range("A6").Value
Ws.Range("D" & L).Resize(10, 13).Value = Ary
L = L + 10

This pulls data into rows A-N
I want all the data repeated on rows A-H then what is in I on the first row, the second would be A-H + J then A-H +K all the way to A-H + N.

I hope that makes sense.

 

[Fluff]

Ok, this is now a completely different question, so you will need to start a new thread.
Thanks

 

[5h1v]

Will do - thanks again for all your help.

 

[Fluff]

My pleasure.