LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 28
Default Copy Multiple Workbooks to Worksheet

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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How can I copy multiple formulas between workbooks at once? Hank Excel Worksheet Functions 1 September 23rd 09 12:06 AM
How do I copy headers/footers to multiple different workbooks? mjzvbms Excel Discussion (Misc queries) 0 August 16th 06 04:10 PM
macro: copy multiple workbooks to multiple tabs in single book Michael Excel Programming 0 July 14th 06 04:53 PM
Copy from multiple workbooks and display the original worksheet na Barb Reinhardt Excel Discussion (Misc queries) 1 October 5th 05 03:51 PM
copy range to multiple workbooks davez Excel Discussion (Misc queries) 4 August 27th 05 01:14 AM


All times are GMT +1. The time now is 05:45 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"