VBA to pull from 2 diff tabs within the same spreadsheet

M

mike

Hi All,

I need your help please. I need to pull data from 2 different tabs from the
same spreadsheet. The code down below after the first "end with" works when
it is run alone, however, when I add the the code at top (to pull from the
other tab) it doesn't work. i know it looks messy and crazy but would anyone
know how to pull data from 2 tabs within the same spreadsheet? I'm hoping
it's a simple fix.

Sub HSSESafetyQuestions()
Dim fso, f, fldnm As String, WB As Workbook, WS As Worksheet, r As Long
Dim ws2 As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

fldnm = "\\bp1lpris001\common\HSSE\WoR10k2005\WoR10kHSSEVBA" 'Folder to
loop through
Set WS = Workbooks("HSSE_WoR_10k_summary.xls").Sheets("HSSE Questions")

r = WS.Cells.Find(What:="*", LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Application.ScreenUpdating = False

'Mike Test
For Each f In fso.GetFolder(fldnm).Files
If UCase(Right(f.Name, 3)) = "XLS" Then
Set WB = Workbooks.Open(f.Path)
Set ws2 = WB.Sheets("WOR Summary")
With WS.Rows(r)
.Columns("j") = ws2.Range("c3").Value
.Columns("k") = ws2.Range("c2").Value
.Columns("l") = ws2.Range("c5").Value
.Columns("m") = ws2.Range("c8").Value
.Columns("n") = ws2.Range("c9").Value
.Columns("o") = ws2.Range("c7").Value
.Columns("p") = ws2.Range("f3").Value
.Columns("q") = ws2.Range("f4").Value
.Columns("r") = ws2.Range("f5").Value
.Columns("s") = ws2.Range("f6").Value
.Columns("t") = ws2.Range("f7").Value
.Columns("u") = ws2.Range("f8").Value
.Columns("v") = ws2.Range("f9").Value
.Columns("w") = ws2.Range("f10").Value



End With
r = r + 1
End If
Next
Application.ScreenUpdating = True




For Each f In fso.GetFolder(fldnm).Files
If UCase(Right(f.Name, 3)) = "XLS" Then
Set WB = Workbooks.Open(f.Path)
Set ws2 = WB.Sheets("WOR Questionnaire")
With WS.Rows(r)
.Columns("x") = ws2.Range("D12").Value
.Columns("y") = ws2.Range("D21").Value
.Columns("z") = ws2.Range("D29").Value
.Columns("aa") = ws2.Range("D55").Value
.Columns("ab") = ws2.Range("D62").Value
.Columns("ac") = ws2.Range("D64").Value
.Columns("ad") = ws2.Range("D70").Value
.Columns("ae") = ws2.Range("D93").Value
.Columns("af") = ws2.Range("D95").Value
.Columns("ag") = ws2.Range("D98").Value
.Columns("ah") = ws2.Range("D99").Value
.Columns("ai") = ws2.Range("D100").Value
.Columns("aj") = ws2.Range("D101").Value
.Columns("ak") = ws2.Range("D103").Value
.Columns("al") = ws2.Range("D104").Value
.Columns("am") = ws2.Range("D105").Value
.Columns("an") = ws2.Range("D106").Value
.Columns("ao") = ws2.Range("D107").Value
.Columns("ap") = ws2.Range("D109").Value
.Columns("aq") = ws2.Range("D108").Value
.Columns("ar") = ws2.Range("D110").Value
.Columns("as") = ws2.Range("D111").Value
.Columns("at") = ws2.Range("D112").Value
.Columns("au") = ws2.Range("D114").Value
.Columns("av") = ws2.Range("D118").Value
.Columns("aw") = ws2.Range("D130").Value
.Columns("ax") = ws2.Range("D119").Value
.Columns("ay") = ws2.Range("D129").Value
.Columns("ba") = ws2.Range("D121").Value
.Columns("bb") = ws2.Range("D122").Value
.Columns("bc") = ws2.Range("D123").Value
.Columns("be") = ws2.Range("D125").Value
.Columns("bf") = ws2.Range("D126").Value
.Columns("bg") = ws2.Range("D127").Value
.Columns("bh") = ws2.Range("D128").Value
.Columns("bi") = ws2.Range("D134").Value
.Columns("bj") = ws2.Range("D147").Value
End With
r = r + 1
WB.SaveAs fldnm & "\archive\" & f.Name
WB.Close
f.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top