More Specific Data-Pull Code

[SoCoMike]

Hey all, so I'm working with the following code to pull information from all workbooks in a folder.

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

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 = owbk.Sheets(1)
ws.Range("A1:L1", Range("A" & Rows.Count).End(xlUp)).Copy
twbk.Sheets(1).Range("A65536").End(xlUp)(2).PasteSpecial xlPasteValues
owbk.Close False
sFil = Dir
Loop
twbk.Save
End Sub

It works, but I would like it to be more precise.
For starters, it will only pull from the active sheet of each in the folder.
Is there a way to be more specific? All of my workbooks have the information on the same sheet, all named 'Sheet 1', but aren't always the last sheet opened before save/close.

Thanks in advance.

 

[Fluff]

Try

[COLOR=#008080]Set ws = owbk.Sheets("Sheet1")[/COLOR]

 

[SoCoMike]

It comes up with the following error on the sheet that I changed to test.

 

[SoCoMike]

[/IMG]

 

[Fluff]

That needs to be

ws.Range("A1:L"& ws.Range("A" & Rows.Count).End(xlUp).row).Copy

 

[SoCoMike]

Magnificent!!
Thank you.

Alternatively, how complicated would the code be if instead I was grabbing multiple cell locations?
To explain, I pretty much set up 'Sheet1' to just pull those values into A1:L1.
Would it be a pain to grab from different areas of the original sheet and deposit them in a flatfile fashion?

 

[Fluff]

Depends on what exactly you are after.
I you can show me what you have now & what you want it to look like, I may be able to help.
There are some tools here https://www.mrexcel.com/forum/about-board/508133-attachments.html
That enable you to post data to the thread.

 

[SoCoMike]

To explain a little more..

These safety score totals are found on multiple locations of the original sheet, Appendix A - LVO.
Their cell locations are F2, F3, C3, C2, H12, H21, H30, H39, H45, H55, H61.
My workaround was setting up a second sheet that would pull those values into an A1:L1 row.
So A1 of Sheet1 would just be ='Appendix A - LVO'!F2

What I would be interested in is the coding for pulling the information from Appendix A - LVO without the need for a Sheet1.
For instance, open/copy/paste the F2 cell from Appendix A - LVO in the new sheet summary into cell location A2.
Then copy/paste Appendix A - LVO cell F3 into new sheet summary cell B2, Appendix A - LVO cell C3 into new sheet summary cell C2, etc until the end (H61).
Close the current workbook and move onto the next in the folder.

Does that make sense?

 

[Fluff]

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 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
         For Each Rng In ws.Range("F2,F3, C3, C2, H12, H21, H30, H39, H45, H55, H61")
            i = i + 1
            .Cells(Lr, i).Value = Rng.Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
End Sub

 

[SoCoMike]

It runs with no results or bug notifications.. hrm.