Hi,

I need to pull information from 2 tabs (one has header info; Wor Summary and the other raw data; WoR Questionnaire) and are within the same worksheet and have it automatically copy it into another spreadsheet. I wrote the code below the line and the code when individually for each tab works fine ... but when combined I only pull information for the 1st tab (Wor Summary) and it doesn't pull information from the 2nd tab (Wor Questionnaire). I think it's failing 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 next code to run to pull data from the next tab. Can anyone help me please?

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