Copy Multiple Workbooks to Worksheet

[Darrell Lankford]

I have used the following code thanks to Ron DeBruin and it works
great to copy the text in multiple workbooks to one sheet. The code
puts the workbook name in the cell at the header row of each sheet
range copied. How can I modify the code to add the workbook name in a
cell on every row? I tried to add a line with filldown, but that only
does the first set, and not the remaining. Any ideas?


Option Explicit

'***Copy a Range from each workbook***
'
'This two examples will copy Range("A1:C1") from the first sheet of
each workbook.
'Change the folder "C:\Data" 0r "\\ComputerName\YourFolder" to your
folder.

'Note: The second macro is also working if your files are in a network
folder.

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
rnum = 1

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A1:C10")'
CHANGED Range("A1:C1")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
' This will add the workbook name in column D if you want

sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only
the values

' With sourceRange
' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
'
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

You can use this Darrell

basebook.Worksheets(1).Cells(rnum, "D").Resize(SourceRcount).Value = mybook.Name

 

[Darrell Lankford]

You can use this Darrell

basebook.Worksheets(1).Cells(rnum, "D").Resize(SourceRcount).Value = mybook.Name

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

















- Show quoted text -

Ron,

That worked great!!

Thanks,
Darrell