Hello,
I am new to this forum, and also somewhat new to VBA, and I have tried posting my problem to another forum as well, but have not been able to receive an answer. Here is the link for the other thread: (I am not allowed to post an actual link due to my low post count, so you need to add the "http" and "www" yourselves!)
mrexcel.com/forum/showthread.php?t=530887&highlight=import+files
My situation is, that I have a bunch of excel files in a folder - Market Surveys, all with the same format. I want the macro to search all excel files in that folder, and get the cell "B4" from all files, and paste them in a column each. The following code does exactly that. My problem is, however, that if the cell "B4" is empty, the macro leaves it out, and pastes the next value from the next file in the following cell. This is a problem, I want it to insert a blank cell if the value is empty, or the string "empty" or whatever, to make sure the columns correspond to the number of files. I am planning to just repeat the code for a number of other cells in the files afterwards, and I therefore need it to be able to copy blanks, text as well as values. If I use the current macro on a range of textcells they are copied just fine, but if I use it on formularesults, the current excel document returns :#VALUE. I therefore also need it to paste values, but I do not know how to include that in my code.
[VBA]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("B4") = "" Then
Range("B4").Insert Shift:=xlDown
End If
With ThisWorkbook.Sheets(1)
wbResults.Sheets("Sheet 2").Range("B4").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[/VBA]