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
 
Ok, how about
Code:
Sub FolderPicker_ExportData()
   Dim wb1 As Workbook, wb2 As Workbook
   Dim Ws As Worksheet
   Dim Ary As Variant
   Dim sPath As String, sFile As String
   Dim L As Long
   
   Set wb1 = ThisWorkbook
   Set Ws = wb1.Sheets.Add(before:=wb1.Sheets(1))

   With Application.FileDialog(msoFileDialogFolderPicker)
      .Title = "Please select one folder"
      .AllowMultiSelect = False
      If .Show = True Then sPath = .SelectedItems(1) & "\"
   End With
   sFile = Dir(sPath & "*.xls*")
   If sFile = "" Then
      MsgBox "No files found"
      Exit Sub
   End If
   
   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("G3").Value
      Ws.Range("A" & L + 1).Resize(, 10).Value = wb2.Sheets(4).Range("A6").Value
      Ws.Range("A" & L + 2).Resize(13, 10).Value = Application.Transpose(Ary)
      L = L + 15
      
      wb2.Close False
      sFile = Dir()
   Loop
   ActiveWorkbook.Save
End Sub
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
That works perfectly,

2 questions I have larger ranges I want this to apply to which are below;

[TABLE="width: 64"]
<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64, align: left"]G3,a6,A8,c8,d8,g8,m8,n8,08,p8,q8,r8,s8,t8,u8[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a6,A9,c9,d9,g9,m9,n9,09,p9,q9,r9,s9,t9,u9[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a6,A10,c10,d10,g10,m10,n10,010,p10,q10,r10,s10,t10,u10[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a6,A11,c11,d11,g11,m11,n11,011,p11,q11,r11,s11,t11,u11[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a6,A12,c12,d12,g12,m12,n12,012,p12,q12,r12,s12,t12,u12[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a6,A13,c13,d13,g13,m13,n13,013,p13,q13,r13,s13,t13,u13[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a6,A14,c14,d14,g14,m14,n14,014,p14,q14,r14,s14,t14,u14[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a6,A15,c15,d15,g15,m15,n15,015,p15,q15,r15,s15,t15,u15[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a6,A16,c16,d16,g16,m16,n16,016,p16,q16,r16,s16,t16,u16[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a6,A17,c17,d17,g17,m17,n17,017,p17,q17,r17,s17,t17,u17[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A20,c20,d20,g20,m20,n20,020,p20,q20,r20,s20,t20,u20[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A21,c21,d21,g21,m21,n21,021,p21,q21,r21,s21,t21,u21[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A22,c22,d22,g22,m22,n22,022,p22,q22,r22,s22,t22,u22[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A23,c23,d23,g23,m23,n23,023,p23,q23,r23,s23,t23,u23[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A24,c24,d24,g24,m24,n24,024,p24,q24,r24,s24,t24,u24[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A25,c25,d25,g25,m25,n25,025,p25,q25,r25,s25,t25,u25[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A26,c26,d26,g26,m26,n26,026,p26,q26,r26,s26,t26,u26[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A27,c27,d27,g27,m27,n27,027,p27,q27,r27,s27,t27,u27[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A28,c28,d28,g28,m28,n28,028,p28,q28,r28,s28,t28,u28[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a18,A29,c29,d29,g29,m29,n29,029,p29,q29,r29,s29,t29,u29[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a32,c32,d32,g32,m32,n32,o32,p32,q32,r32,s32,t32,u32[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a33,c33,d33,g33,m33,n33,o33,p33,q33,r33,s33,t33,u33[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a34,c34,d34,g34,m34,n34,o34,p34,q34,r34,s34,t34,u34[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a35,c35,d35,g35,m35,n35,o35,p35,q35,r35,s35,t35,u35[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a36,c36,d36,g36,m36,n36,o36,p36,q36,r36,s36,t36,u36[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a37,c37,d37,g37,m37,n37,o37,p37,q37,r37,s37,t37,u37[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a38,c38,d38,g38,m38,n38,o38,p38,q38,r38,s38,t38,u38[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a39,c39,d39,g39,m39,n39,o39,p39,q39,r39,s39,t39,u39[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a40,c40,d40,g40,m40,n40,o40,p40,q40,r40,s40,t40,u40[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a41,c41,d41,g41,m41,n41,o41,p41,q41,r41,s41,t41,u41[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a42,c42,d42,g42,m42,n42,o42,p42,q42,r42,s42,t42,u42[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a43,c43,d43,g43,m43,n43,o43,p43,q43,r43,s43,t43,u43[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a44,c44,d44,g44,m44,n44,o44,p44,q44,r44,s44,t44,u44[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a45,c45,d45,g45,m45,n45,o45,p45,q45,r45,s45,t45,u45[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a46,c46,d46,g46,m46,n46,o46,p46,q46,r46,s46,t46,u46[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a47,c47,d47,g47,m47,n47,o47,p47,q47,r47,s47,t47,u47[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a48,c48,d48,g48,m48,n48,o48,p48,q48,r48,s48,t48,u48[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a49,c49,d49,g49,m49,n49,o49,p49,q49,r49,s49,t49,u49[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a50,c50,d50,g50,m50,n50,o50,p50,q50,r50,s50,t50,u50[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a51,c51,d51,g51,m51,n51,o51,p51,q51,r51,s51,t51,u51[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a52,c52,d52,g52,m52,n52,o52,p52,q52,r52,s52,t52,u52[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a53,c53,d53,g53,m53,n53,o53,p53,q53,r53,s53,t53,u53[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a54,c54,d54,g54,m54,n54,o54,p54,q54,r54,s54,t54,u54[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a55,c55,d55,g55,m55,n55,o55,p55,q55,r55,s55,t55,u55[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a56,c56,d56,g56,m56,n56,o56,p56,q56,r56,s56,t56,u56[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a57,c57,d57,g57,m57,n57,o57,p57,q57,r57,s57,t57,u57[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a58,c58,d58,g58,m58,n58,o58,p58,q58,r58,s58,t58,u58[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a59,c59,d59,g59,m59,n59,o59,p59,q59,r59,s59,t59,u59[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a60,c60,d60,g60,m60,n60,o60,p60,q60,r60,s60,t60,u60[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a61,c61,d61,g61,m61,n61,o61,p61,q61,r61,s61,t61,u61[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a62,c62,d62,g62,m62,n62,o62,p62,q62,r62,s62,t62,u62[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a30,a63,c63,d63,g63,m63,n63,o63,p63,q63,r63,s63,t63,u63[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a66,c66,d66,i66,m66,n66,o66,p66,q66,r66,s66,t66,u66[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a67,c67,d67,i67,m67,n67,o67,p67,q67,r67,s67,t67,u67[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a68,c68,d68,i68,m68,n68,o68,p68,q68,r68,s68,t68,u68[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a69,c69,d69,i69,m69,n69,o69,p69,q69,r69,s69,t69,u69[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a70,c70,d70,i70,m70,n70,o70,p70,q70,r70,s70,t70,u70[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a71,c71,d71,i71,m71,n71,o71,p71,q71,r71,s71,t71,u71[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a72,c72,d72,i72,m72,n72,o72,p72,q72,r72,s72,t72,u72[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a73,c73,d73,i73,m73,n73,o73,p73,q73,r73,s73,t73,u73[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a74,c74,d74,i74,m74,n74,o74,p74,q74,r74,s74,t74,u74[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a75,c75,d75,i75,m75,n75,o75,p75,q75,r75,s75,t75,u75[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a64,a76,c76,d76,i76,m76,n76,o76,p76,q76,r76,s76,t76,u76[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c80,d80,e80,f80,g80,h80,i80,j80[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c81,d81,e81,f81,g81,h81,i81,j81[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c82,d82,e82,f82,g82,h82,i82,j82[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c83,d83,e83,f83,g83,h83,i83,j83[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c84,d84,e84,f84,g84,h84,i84,j84[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c85,d85,e85,f85,g85,h85,i85,j85[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c86,d86,e86,f86,g86,h86,i86,j86[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c87,d87,e87,f87,g87,h87,i87,j87[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c80,d80,e80,f80,l80,m80,n80,o80[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c81,d81,e81,f81,l81,m81,n81,o81[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c82,d82,e82,f82,l82,m82,n82,o82[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c83,d83,e83,f83,l83,m83,n83,o83[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c84,d84,e84,f84,l84,m84,n84,o84[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c85,d85,e85,f85,l85,m85,n85,o85[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c86,d86,e86,f86,l86,m86,n86,o86[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c87,d87,e87,f87,l87,m87,n87,o87[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c80,d80,e80,f80,q80,r80,s80,t80[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c81,d81,e81,f81,q81,r81,s81,t81[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c82,d82,e82,f82,q82,r82,s82,t82[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c83,d83,e83,f83,q83,r83,s83,t83[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c84,d84,e84,f84,q84,r84,s84,t84[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c85,d85,e85,f85,q85,r85,s85,t85[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c86,d86,e86,f86,q86,r86,s86,t86[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c87,d87,e87,f87,q87,r87,s87,t87[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c90,d90,e90,f90,g90,h90,i90,j90[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c91,d91,e91,f91,g91,h91,i91,j91[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c92,d92,e92,f92,g92,h92,i92,j92[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c93,d93,e93,f93,g93,h93,i93,j93[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c94,d94,e94,f94,g94,h94,i94,j94[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c95,d95,e95,f95,g95,h95,i95,j95[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c96,d96,e96,f96,g96,h96,i96,j96[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c97,d97,e97,f97,g97,h97,i97,j97[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c90,d90,e90,f90,l90,m90,n90,o90[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c91,d91,e91,f91,l91,m91,n91,o91[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c92,d92,e92,f92,l92,m92,n92,o92[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c93,d93,e93,f93,l93,m93,n93,o93[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c94,d94,e94,f94,l94,m94,n94,o94[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c95,d95,e95,f95,l95,m95,n95,o95[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c96,d96,e96,f96,l96,m96,n96,o96[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c97,d97,e97,f97,l97,m97,n97,o97[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c90,d90,e90,f90,q90,r90,s90,t90[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c91,d91,e91,f91,q91,r91,s91,t91[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c92,d92,e92,f92,q92,r92,s92,t92[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c93,d93,e93,f93,q93,r93,s93,t93[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c94,d94,e94,f94,q94,r94,s94,t94[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c95,d95,e95,f95,q95,r95,s95,t95[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c96,d96,e96,f96,q96,r96,s96,t96[/TD]
[/TR]
[TR]
[TD="align: left"]G3,a77,c97,d97,e97,f97,q97,r97,s97,t97

could I then just change the range A8:U17 to encompass these as well?[/TD]
[/TR]
</tbody>[/TABLE]

and could I change it so that the it populates cells A1:O1 instead of A1:A15?
 
Upvote 0
You would need to replicate the code for each block of cells, as it only works with contiguous rows.
For the 2nd question, I don't understand. If this G3,a6,A8,c8,d8,g8,m8,n8,08,p8,q8,r8,s8,t8,u8 goes in A1:O1 instead of A1:A15 where does this go G3,a6,A9,c9,d9,g9,m9,n9,09,p9,q9,r9,s9,t9,u9, as it can't go in B1:B15 anymore?
 
Upvote 0
Thats great I can replicate it for each block, they would drop into rows instead of columns so A1:01, A2:O2, A3:03 etc etc

Ill try replicating the rest now
 
Upvote 0
If you don't want to transpose the date try
Code:
      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("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A6").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
      L = L + 10
 
Upvote 0
That works perfectly - thank you so much.

I have just tried to add in the next block and that is working perfectly as well.

You have no idea how much time you have saved me.
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
Sorry, I have one more questions, the blocks of data are different lengths so and it is not bringing back all the data, could you tell me why this is, I must have not changed everything that I needed to;

Code:
Sub FolderPicker_ExportData()
   Dim wb1 As Workbook, wb2 As Workbook
   Dim Ws As Worksheet
   Dim Ary As Variant
   Dim sPath As String, sFile As String
   Dim L As Long
   
   Set wb1 = ThisWorkbook
   Set Ws = wb1.Sheets.Add(before:=wb1.Sheets(1))


   With Application.FileDialog(msoFileDialogFolderPicker)
      .Title = "Please select one folder"
      .AllowMultiSelect = False
      If .Show = True Then sPath = .SelectedItems(1) & "\"
   End With
   sFile = Dir(sPath & "*.xls*")
   If sFile = "" Then
      MsgBox "No files found"
      Exit Sub
   End If
   
   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("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A6").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
      L = L + 10
    Set wb2 = Workbooks.Open(sPath & sFile)
      Ary = Application.Index(wb2.Sheets(4).Range("A20:U29").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("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A18").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
      L = L + 10
    Set wb2 = Workbooks.Open(sPath & sFile)
      Ary = Application.Index(wb2.Sheets(4).Range("A32:U63").Value, Evaluate("row(1:31)"), Array(1, 3, 4, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15))
      Ws.Range("A" & L).Resize(10).Value = wb2.Sheets(4).Range("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A30").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
      L = L + 31
    Set wb2 = Workbooks.Open(sPath & sFile)
      Ary = Application.Index(wb2.Sheets(4).Range("A66:U76").Value, Evaluate("row(1:11)"), Array(1, 3, 4, 7, 10, 11, 12, 13, 14, 15, 16, 17, 18))
      Ws.Range("A" & L).Resize(10).Value = wb2.Sheets(4).Range("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A64").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
      L = L + 11
    Set wb2 = Workbooks.Open(sPath & sFile)
      Ary = Application.Index(wb2.Sheets(4).Range("A80:j87").Value, Evaluate("row(1:8)"), Array(1, 3, 4, 5, 6, 7, 8, 9, 10))
      Ws.Range("A" & L).Resize(10).Value = wb2.Sheets(4).Range("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A77").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
         L = L + 8
    Set wb2 = Workbooks.Open(sPath & sFile)
      Ary = Application.Index(wb2.Sheets(4).Range("A80:o87").Value, Evaluate("row(1:8)"), Array(1, 3, 4, 5, 6, 12, 13, 14, 15))
      Ws.Range("A" & L).Resize(10).Value = wb2.Sheets(4).Range("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A77").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
         L = L + 8
    Set wb2 = Workbooks.Open(sPath & sFile)
      Ary = Application.Index(wb2.Sheets(4).Range("A80:t87").Value, Evaluate("row(1:8)"), Array(1, 3, 4, 5, 6, 17, 18, 19, 20))
      Ws.Range("A" & L).Resize(10).Value = wb2.Sheets(4).Range("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A77").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
         L = L + 8
      
      wb2.Close False
      sFile = Dir()
   Loop
   ActiveWorkbook.Save
End Sub
 
Upvote 0
You need to change the resize like
Code:
      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("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A6").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
      L = L + 10
      Ary = Application.Index(wb2.Sheets(4).Range("A20:U29").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("G3").Value
      Ws.Range("B" & L).Resize(10).Value = wb2.Sheets(4).Range("A18").Value
      Ws.Range("C" & L).Resize(10, 13).Value = Ary
      L = L + 10
      Ary = Application.Index(wb2.Sheets(4).Range("A32:U63").Value, Evaluate("row(1:31)"), Array(1, 3, 4, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15))
      Ws.Range("A" & L).Resize([COLOR=#ff0000]31[/COLOR]).Value = wb2.Sheets(4).Range("G3").Value
      Ws.Range("B" & L).Resize([COLOR=#ff0000]31[/COLOR]).Value = wb2.Sheets(4).Range("A30").Value
      Ws.Range("C" & L).Resize([COLOR=#ff0000]31[/COLOR], 13).Value = Ary
      L = L + 31
      Ary = Application.Index(wb2.Sheets(4).Range("A66:U76").Value, Evaluate("row(1:11)"), Array(1, 3, 4, 7, 10, 11, 12, 13, 14, 15, 16, 17, 18))
      Ws.Range("A" & L).Resize([COLOR=#ff0000]11[/COLOR]).Value = wb2.Sheets(4).Range("G3").Value
      Ws.Range("B" & L).Resize([COLOR=#ff0000]11[/COLOR]).Value = wb2.Sheets(4).Range("A64").Value
      Ws.Range("C" & L).Resize([COLOR=#ff0000]11[/COLOR], 13).Value = Ary
      L = L + 11
You also don't need all those workbook.open lines, just once at the start of the loop
 
Upvote 0

Forum statistics

Threads
1,223,909
Messages
6,175,315
Members
452,634
Latest member
cpostell

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
Back
Top