Data Grab from Closed Workbooks - Cell Reference Bug?

[SoCoMike]

So I am attempting to pull a LOT of cells from closed workbooks in a folder, I know it works on a small scale.. but when I put in this many cells it doesn't.
Here is the code.

Sub OpenFile()
   Dim sPath As String
   Dim sFil As String
   Dim strName As String
   Dim twbk As Workbook
   Dim owbk As Workbook
   Dim ws As Worksheet
   Dim Rng As Range
   Dim i As Long, Lr As Long
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets(1)
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
            i = 0
         For Each Rng In ws.Range("F2, F3, C3, C2, H7, G7, F7, E7, H8, G8, F8, E8, H9, G9, F9, E9, H10, G10, F10, E10, H11, G11, F11, E11, H16, G16, F16, E16, H17, G17, F17, E17, H18, G18, F18, E18, H19, G19, F19, E19, H25, G25, F25, E25, H26, G26, F26, E26, H27, G27, F27, E27, H28, G28, F28, E28, H29, G29, F29, E29, H34, G34, F34, E34, H35, G35, F35, E35, H36, G36, F36, E36, H37, G37, F37, E37, H38, G38, F38, E38, H43, G43, F43, E43, H44, G44, F44, E44, H50, G50, F50, E50, H51, G51, F51, E51, H52, G52, F52, E52, H53, G53, F53, E53, H54, G54, F54, E54, H59, G59, F59, E59, H60, G60, F60, E60,")
            i = i + 1
            .Cells(Lr, i).Value = Rng.Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
End Sub

 

[Fluff]

I suspect that you have hit a limit of some sort. Try

Sub OpenFile()
   Dim sPath As String
   Dim sFil As String
   Dim strName As String
   Dim twbk As Workbook
   Dim owbk As Workbook
   Dim ws As Worksheet
   Dim Rng As Variant, rngstr As String
   Dim i As Long, Lr As Long
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets(1)
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
         i = 0
         rngstr = "F2,F3,C3,C2,H7,G7,F7,E7,H8,G8,F8,E8,H9,G9,F9,E9,H10,G10,F10,E10,H11,G11,F11,E11,H16,G16,F16,E16,H17,G17,F17,E17,H18,G18,F18,E18,H19,G19,F19,E19,H25,G25,F25,E25,H26,G26,F26,E26,H27,G27,F27,E27,H28,G28,F28,E28,H29,G29,F29,E29,H34,G34,F34,E34,H35,G35,F35,E35,H36,G36,F36,E36, H37, G37, F37, E37, H38, G38, F38, E38, H43, G43, F43, E43, H44, G44, F44, E44, H50, G50, F50, E50, H51, G51, F51, E51, H52, G52, F52, E52, H53, G53, F53, E53, H54, G54, F54, E54, H59, G59, F59, E59, H60, G60, F60, E60"
         For Each Rng In Split(rngstr, ",")
            i = i + 1
            .Cells(Lr, i).Value = ws.Range(Rng).Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
End Sub

 

[RoryA]

There's a limit of 255 characters for the address you can use with the Range property.

 

[SoCoMike]

Thanks guys, works like a charm!!
I did not know that, yeah it worked with like 20 characters before.. figured there must have been a limit of some sort.

 

[Fluff]

Glad we could help & thanks for the feedback

 

[SoCoMike]

In the interest of being able to pivot this data easier, I split the macro into two separate codes to be ran.
When I run the larger bulk of the code, it only goes through 29 files in the folder.. while the shorter version will process all 55 files.

Any ideas why?

Code for reference.

Sub OpenFile()
[COLOR=#008080]   Dim sPath As String
   Dim sFil As String
   Dim strName As String
   Dim twbk As Workbook
   Dim owbk As Workbook
   Dim ws As Worksheet
   Dim Rng As Variant, rngstr As String
   Dim i As Long, Lr As Long
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets(1)
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
         i = 0
         rngstr = "H7,G7,F7,E7,H8,G8,F8,E8,H9,G9,F9,E9,H10,G10,F10,E10,H11,G11,F11,E11,H16,G16,F16,E16,H17,G17,F17,E17,H18,G18,F18,E18,H19,G19,F19,E19,H20,D20,H25,G25,F25,E25,H26,G26,F26,E26,H27,G27,F27,E27,H28,G28,F28,E28,H29,G29,F29,E29,H34,G34,F34,E34,H35,G35,F35,E35,H36,D36, H37, D37, H38, D38, H43, G43, F43, E43, H44, G44, F44, E44, H50, G50, F50, E50, H51, G51, F51, E51, H52, G52, F52, E52, H53, G53, F53, E53, H54, G54, F54, E54, H59, D59, H60, D60"
         For Each Rng In Split(rngstr, ",")
            i = i + 1
            .Cells(Lr, i).Value = ws.Range(Rng).Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
End Sub[/COLOR]

 

[Fluff]

Does it open all 55 files & only copy data from 29, or does it only open 29 files?

PS. When posting code please use code tags, the # icon in the reply window.

 

[SoCoMike]

It opens all 55 files, only copy and pastes from the first 28.

 

[SoCoMike]

For clarity's sake, this is the combined code right now.

Option Explicit
Sub OpenFile()
   Dim sPath As String
   Dim sFil As String
   Dim strName As String
   Dim twbk As Workbook
   Dim owbk As Workbook
   Dim ws As Worksheet
   Dim Rng As Variant, rngstr As String
   Dim i As Long, Lr As Long
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits\"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets("Charted Data")
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
         i = 0
         rngstr = "H7,G7,F7,E7,H8,G8,F8,E8,H9,G9,F9,E9,H10,G10,F10,E10,H11,G11,F11,E11,H16,G16,F16,E16,H17,G17,F17,E17,H18,G18,F18,E18,H19,G19,F19,E19,H20,D20,H25,G25,F25,E25,H26,G26,F26,E26,H27,G27,F27,E27,H28,G28,F28,E28,H29,G29,F29,E29,H34,G34,F34,E34,H35,G35,F35,E35,H36,D36, H37, D37, H38, D38, H43, G43, F43, E43, H44, G44, F44, E44, H50, G50, F50, E50, H51, G51, F51, E51, H52, G52, F52, E52, H53, G53, F53, E53, H54, G54, F54, E54, H59, D59, H60, D60"
         For Each Rng In Split(rngstr, ",")
            i = i + 1
            .Cells(Lr, i).Value = ws.Range(Rng).Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
   
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits\"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets("Flatfile")
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
         i = 0
         rngstr = "F2,F3,C3,C2"
         For Each Rng In Split(rngstr, ",")
            i = i + 1
            .Cells(Lr, i).Value = ws.Range(Rng).Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
   
End Sub

 

[Fluff]

At a guess F2 is blank in some of those files