Thread: Adding filename
View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Basta1980 Basta1980 is offline
external usenet poster
 
Posts: 102
Default Adding filename

Hi all,

I got this code from Ron de Bruins' internet page. It works perfect. Now I
want to add one more thing which is the corresponding filename in Column A
(in Column B) the amount or data is shown). In other words in column A the
filenames is listed and next to it, in column B the corresponding value is
listed. How can I tweak the code to include filenames?!

Thanks in advance & greetings

Sub CopyRangeValues()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "D:\Data\Test"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(3).Range("d62")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
End If
End With
Application.ScreenUpdating = True
End Sub