how to pull info from multiple tabs within same wosksheet?
 

Hi,

I need to pull information from 2 tabs (one has header info; Wo
Summary and the other raw data; WoR Questionnaire) and are within th
same worksheet and have it automatically copy it into anothe
spreadsheet. I wrote the code below the line and the code whe
individually for each tab works fine ... but when combined I only pul
information for the 1st tab (Wor Summary) and it doesn't pul
information from the 2nd tab (Wor Questionnaire). I think it's failin
at the part where it has;

End With
r = r + 1
End If
Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Cuz it thinks it needs to stop therefore it fails to go to the nex
code to run to pull data from the next tab. Can anyone help me please?


Code
-------------------

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

fldnm = "C:\Documents and Settings\moyea0\My Documents\Andreea\10k\2005\Data" 'Folder to loop through

Set WS = Workbooks("HSSE_WoR_10k_master.xls").Sheets("HSSE Questions")

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

x = 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 = False
Application.DisplayAlerts = False


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(x)
.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
x = x + 1
WB.SaveAs fldnm & "\Archive_" & Right(f, Len(f) - 41)
WB.Close
f.Delete
End If
Next
Application.ScreenUpdating = True
End Sub

--------------------


--
inspirz
------------------------------------------------------------------------
inspirz's Profile: http://www.excelforum.com/member.php...o&userid=29469
View this thread: http://www.excelforum.com/showthread...hreadid=491743