Error 400

[shanks1983]

Hi All,

I am still new to VBA and i am having a problem with the below code.

What i need it to do is open all the workbooks in the folder specified and collect all the data from the sheet named "data" and copy the data on row 1 to a documnet called "Survey Results" and paste the info into the sheet named "data"

when i run the code it returns a error "400" can anyone see were i am going wrong and perhaps help me out.

Many thanks

[VBA]
Sub open_workbooks_same_folder()

Dim folder As String
Dim Wb As Workbook, sFile As String

folder = "G:\TEAM HR Central Support BNB Resourcing\Survey Results\"

sFile = Dir(folder & "*.xls")
Do While sFile <> ""
On Error GoTo skip
Set Wb = Workbooks.Open(folder & sFile)

Wb.Activate
Sheets("Data").Select
Range("A2:AZ2").Select
Selection.Copy
Windows("Survey Results.xls").Activate
Sheets("Data").Select
Range("A2").Select
ActiveSheet.Paste

Wb.Close True
skip:
sFile = Dir
Loop
End Sub
[/VBA]

[Charlize]

Not tested :[VBA]Sub open_workbooks_same_folder()
Dim folder As String
Dim Wb As Workbook, sFile As String
Dim Cwb As Workbook
Dim Ws As Worksheet

folder = "G:\TEAM HR Central Support BNB Resourcing\Survey Results\"

Set Cwb = ActiveWorkbook

sFile = Dir(folder & "*.xls")
Do While sFile <> "" And sFile <> Cwb.Name
On Error Resume Next
Set Wb = Workbooks.Open(folder & sFile)
Set Ws = Wb.Sheets("Data")
Wb.Ws.Range("A2:AZ2").Copy _
Cwb.Worksheets("Data").Range("A" & Cwb.Worksheets("Data").Range("A" & _
Rows.Count).End(xlUp).Row + 1)
Wb.Close True
sFile = Dir
Loop
End Sub[/VBA]

[shanks1983]

Charlize ,

that has gotten rid of the error and seems to be opening all the workbooks and closing them fine. It is not pasting any of the info into the main database is this somethign that was left out.

[Charlize]

Revised code, hopefully this will do the trick :[vba]Sub open_workbooks_same_folder()
Dim folder As String
Dim Wb As Workbook, sFile As String
Dim Cwb As Workbook
Dim lrow As Long
folder = "G:\TEAM HR Central Support BNB Resourcing\Survey Results\"
Set Cwb = ThisWorkbook
sFile = Dir(folder & "*.xls")
Do While sFile <> ""
If sFile <> Cwb.Name Then
'If there are sheets without a data sheet
'continue with code to import
'the rest that has a sheet with the name data
On Error Resume Next
Set Wb = Workbooks.Open(folder & sFile)
lrow = Cwb.Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Row
lrow = lrow + 1
Wb.Worksheets("Data").Range("A2:AZ2").Copy
Cwb.Worksheets("Data").Range("A" & lrow).PasteSpecial xlPasteValues
Wb.Close True
End If
sFile = Dir
Loop
End Sub[/vba]

[shanks1983]

charlize,

You are my saviour works a charm.

thanks you so much