Macro for importing data from files

[Katla]

Hello, I am new to this forum and also new to VBA, although I have been able to get a couple of macros working.

What I am trying to do, is to import values from a number of files in a folder (market surveys) where all the work sheet names and cell formats are the same and combine them in one sheet. I have found this formula which works fine, except I want it to insert a blank cell if there is no data in the found cell in the file, and I want it to paste the values only. I am using Professional 2000, if it makes a difference.
Thank you in advance.


Sub runonalltotal()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\Documents"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
'.Filename = "Book*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)


With ThisWorkbook.Sheets(1)
wbResults.Sheets("Sheet 1").Range("I54:I54").Copy _
Destination:=.Cells(2, .Columns.Count).End(xlToLeft)(1, 2)
Application.CutCopyMode = False
End With


wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

[Katla]

Can't wait to try, but where in my code would I paste it? I'm a bit new to VBA...

 

[machopicho]

With ThisWorkbook.Sheets(1)
wbResults.Sheets("Sheet 1").Range("I54:I54").Copy _
Destination:=.Cells(2, .Columns.Count).End(xlToLeft)(1, 2)
Application.CutCopyMode = False
End With
 
[COLOR=red]TRY HERE...

[/COLOR]wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub <!-- / message -->

 

[Katla]

Hi, sorry but have not been able to try it before now, and I cannot get it to work. Do I have to insert your code under the bit of my own code, or do I need to replace some of it?

 

[machopicho]

Hi, sorry but have not been able to try it before now, and I cannot get it to work. Do I have to insert your code under the bit of my own code, or do I need to replace some of it?

Sub runonalltotal()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\Documents"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
'.Filename = "Book*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
 
If Range("I54") = "" Then
Range("I54").Insert Shift:=xlDown
End If
With ThisWorkbook.Sheets(1)
wbResults.Sheets("Sheet 1").Range("I54").Copy _
Destination:=.Cells(2, .Columns.Count).End(xlToLeft)(1, 2)
Application.CutCopyMode = False
End With
 
wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

[Katla]

Well, the code seems to work exactly like it did before. It inserts all the values next to each other without inserting blanks, and if the value is the result of a formula, it returns #VALUE. But looking at the code I assume you were only trying to help me solve the blanks-problem, right?

 

[machopicho]

Well... you can solve #VALUE problem looking for in the help of excel; search ISERR or ISERROR formula.

Now, i need a pleasure from you...read my private message. Thanks!

 

[Katla]

That does not help me. But thank you for your time