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)


"Basta1980" wrote:

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" wrote:

This is old code and not working anymore in 2007

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



"Basta1980" wrote:

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