Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How can I copy multiple formulas between workbooks at once? | Excel Worksheet Functions | |||
How do I copy headers/footers to multiple different workbooks? | Excel Discussion (Misc queries) | |||
macro: copy multiple workbooks to multiple tabs in single book | Excel Programming | |||
Copy from multiple workbooks and display the original worksheet na | Excel Discussion (Misc queries) | |||
copy range to multiple workbooks | Excel Discussion (Misc queries) |