PDA

View Full Version : [SOLVED:] Copy Multi WorkBooks To master



Desert Piranha
09-07-2005, 07:06 PM
Hi Everyone,
I have nine workbooks sent to me weekly. In each i am trying to copy the last "used row" and paste it into the master workbook (to a set range).

I can do the copy for a specific range, but having trouble with copying the last used row.

Other thing i am having trouble with is, i am opening each workbook to do the task. But i was interested in doing it without opening the workbooks.

The code i have here i know is pretty bad. This sample is for only two of the nine workbooks. I only know how to piggyback them.

Assume the workbooks are named BookOne, BookTwo, BookThree, BookFour etc

The workbooks are all in the same folder. This code will work. I am Trying to get more automation.


Option Explicit
Sub CopyPasteStoreData()
Application.ScreenUpdating = False
'This is copying workbook # 1
'Here i don't know if i need to do this
'without opening the workbooks
Workbooks.Open ThisWorkbook.Path & "\BookOne.xls"
'Here i need to copy the last used row
'instead of Range("A4:Q4").Select.
'Test in Col A would work.
Range("A4:Q4").Select
Selection.Copy
Windows("MasterBook.xls").Activate
'This range i can hard code, as each workbook will have its own line
Range("A4").Select
ActiveSheet.Paste
Range("D1").Select
Windows("BookOne.xls").Activate
Application.CutCopyMode = False
Range("D1").Select
ActiveWindow.Close
'This is copying workbook # 2. There will be nine total.
Workbooks.Open ThisWorkbook.Path & "\BookTwo.xls"
Range("A4:Q4").Select
Selection.Copy
Windows("MasterBook.xls").Activate
Range("A6").Select
ActiveSheet.Paste
Range("D1").Select
Windows("BookTwo.xls").Activate
Application.CutCopyMode = False
Range("D1").Select
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub

Justinlabenne
09-08-2005, 06:02 AM
Please provide the following to help with a solution:


The actual 9 workbook names (or if they differ, what is the name of the folder the are stored in at least)
The hard coded range for each of the 9 workbooks in the master workbook that will be pasted to
The sheet name of the last used row in each of the 9 workbooks, or if it is the 1st sheet (only sheet)
The last used row, range or entire row? *Range("A1:Q1")*
Dancing Women.

Desert Piranha
09-08-2005, 11:08 AM
Please provide the following to help with a solution:

The actual 9 workbook names (or if they differ, what is the name of the folder the are stored in at least)
The hard coded range for each of the 9 workbooks in the master workbook that will be pasted to
The sheet name of the last used row in each of the 9 workbooks, or if it is the 1st sheet (only sheet)
The last used row, range or entire row? *Range("A1:Q1")*
Dancing Women.

Hi Justin, Thx a lot.
1:
0453 Weekly Numbers.xls
1833 Weekly Numbers.xls
1903 Weekly Numbers.xls
1929 Weekly Numbers.xls
5194 Weekly Numbers.xls
8553 Weekly Numbers.xls
8598 Weekly Numbers.xls
8600 Weekly Numbers.xls
8750 Weekly Numbers.xls

The name of the folder they are stored in is "MyFolder" but that will probably change. The master workbook "Weekly Numbers For MM" is also in this folder. There will probably be other files in this folder, that have no bearing on this task.
2:
The Master workbook is named "Weekly Numbers For MM"
"Sheet1" ranges to be pasted to are
0453 range is A4:S4
1833 range is A6:S6
1903 range is A8:S8
1929 range is A10:S10
5194 range is A12:S12
8553 range is A14:S14
8598 range is A16:S16
8600 range is A18:S18
8750 range is A20:S20
3:
Yes only one sheet in all workbooks "Sheet1"
4:
The Workbooks that are being copied from.
The columns will always be A through S.
But each week, a new row is added.
I only want the last row entered, to be copied to the Master workbook. So i am assuming, the "whole row" "last used row" would be easier than trying to get A through S.
5:
Dancing Women are dancing, can't you see them?

Justinlabenne
09-09-2005, 12:09 AM
Here is a bit of thrown together code:

It uses a Folder Browser because you said the folder name may change. I wrote the names of the 9 workbooks you will be getting data from into a sheet in the Master Workbook. You will either need to change the code, or create a sheet with the workbook names on it, and change to code to refer to that sheet name. You can see in the attached example:


Option Explicit
Sub GetDataFromFiles()
' DISPLAY A FOLDER BROWSER
Dim objFolder As Object
Set objFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Select a Folder", _
0, Empty)
If Not objFolder Is Nothing Then
'Using a function we add backslash to the
'selected folder if one is needed
Dim szFolderPath As String
szFolderPath = fCheckPath(objFolder.items.Item.Path)
Else
GoTo ExitProc
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
If Val(.Version >= 9) Then
.ShowWindowsInTaskbar = False
End If
Dim lRow As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim I As Integer
I = 4
Dim x As Integer
On Error GoTo ErrOccur
For x = 1 To 9
Workbooks.Open szFolderPath & Sheet2.Range("A" & x).Value
lRow = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ActiveWorkbook.Worksheets(1).Range("A" & lRow & ":" & "S" & lRow).Copy _
Workbooks(1).Worksheets(1).Range("A" & I)
ActiveWorkbook.Close False
I = I + 2
Next x
ExitProc:
.ScreenUpdating = True
.EnableEvents = True
If Val(.Version >= 9) Then
.ShowWindowsInTaskbar = True
End If
End With
Exit Sub
ErrOccur:
MsgBox Err.Description
GoTo ExitProc
End Sub

Private Function fCheckPath(Path As String) As String
'Function to add a trailing backslash onto
'a given path if needed
'Xcav8r
Dim szPathSep As String
szPathSep = Application.PathSeparator
Select Case Right(Path, 1)
Case szPathSep
fCheckPath = Path
Case Else
fCheckPath = Path & szPathSep
End Select
End Function

Desert Piranha
09-10-2005, 12:20 AM
Hi Justin,
Thx so much for all your work here. I am trying to figure it out. I will get back to you.


Here is a bit of thrown together code:

It uses a Folder Browser because you said the folder name may change. I wrote the names of the 9 workbooks you will be getting data from into a sheet in the Master Workbook. You will either need to change the code, or create a sheet with the workbook names on it, and change to code to refer to that sheet name. You can see in the attached example:


Option Explicit
Sub GetDataFromFiles()
' DISPLAY A FOLDER BROWSER
Dim objFolder As Object
Set objFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Select a Folder", _
0, Empty)
If Not objFolder Is Nothing Then
'Using a function we add backslash to the
'selected folder if one is needed
Dim szFolderPath As String
szFolderPath = fCheckPath(objFolder.items.Item.Path)
Else
GoTo ExitProc
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
If Val(.Version >= 9) Then
.ShowWindowsInTaskbar = False
End If
Dim lRow As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim I As Integer
I = 4
Dim x As Integer
On Error GoTo ErrOccur
For x = 1 To 9
Workbooks.Open szFolderPath & Sheet2.Range("A" & x).Value
lRow = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ActiveWorkbook.Worksheets(1).Range("A" & lRow & ":" & "S" & lRow).Copy _
Workbooks(1).Worksheets(1).Range("A" & I)
ActiveWorkbook.Close False
I = I + 2
Next x
ExitProc:
.ScreenUpdating = True
.EnableEvents = True
If Val(.Version >= 9) Then
.ShowWindowsInTaskbar = True
End If
End With
Exit Sub
ErrOccur:
MsgBox Err.Description
GoTo ExitProc
End Sub

Private Function fCheckPath(Path As String) As String
'Function to add a trailing backslash onto
'a given path if needed
'Xcav8r
Dim szPathSep As String
szPathSep = Application.PathSeparator
Select Case Right(Path, 1)
Case szPathSep
fCheckPath = Path
Case Else
fCheckPath = Path & szPathSep
End Select
End Function

Desert Piranha
09-12-2005, 08:38 PM
Justin

Thx for your work and time. I kinda got things going ok.

Thx much