Copy Multiple Workbooks to Worksheet

  • Thread starter Darrell Lankford
  • Start date

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

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

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
'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()
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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question