Adding filename

[Basta1980]

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

 

[Ron de Bruin]

This is old code and not working anymore in 2007

Try this
http://www.rondebruin.nl/copy3.htm

 

[Basta1980]

Hi Ron,

Thanks (by the way, this means you don't have to reply on my gmail e-mail
from last saturday ;-))

Met vriendelijke groet,

Basta1980

 

[Basta1980]

Hi Ron,

Is het ook mogelijk om de code zodanig aan te passen dat de data niet in een
nieuwe maar in een bestaande file komt te staan.

Gr.

Basta1980

 

[Ron de Bruin]

Hallo (Hi)

Je kan dit gebruiken voor het aktieve werkblad
You can use this if you want to copy to the ActiveSheet

Set BaseWks =ActiveSheet

Inplaats van (Instead of)
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)