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
Similar Threads
