I have a list of the sheets in question in column A;
thanks to postings on this board I have a routine which
repeats the actions on each sheet.
However when switching between the master and the targets
for copying, the macro still only refers to the first
target sheet (ie the one the single routine was written
for, before the indexing routine was added).
To clarify
Initial routine was:
1. Copy file name from A1 in Master Book and use to open
Workbook 1
2. Go to Book 1 and copy data A
3. Go to Master Book and paste data A
4. Go to Book 1 and copy data B
5. Go to Master Book and paste data B
6. Go to Book 1 and copy data C
7. Go to Master Book and paste data C
8. Close Book 1
I have a way of repeating using A2 to open Workbook 2 (up
to Ax)
However when this runs lines 2, 4 & 6 still refer to Book
1 (instead of Book x, where x is row number)
This seems to be because when writing the original single
routine, I was switching between Master Book and Book 1 by
selecting Window from the top toolbar, and then clicking
on Book 1 – the name of Book 1 has therefore been
hardcoded? into the routine (as an absolute reference
rather than relative).
Is there a way of keeping the name of the target 'soft' ie
it needs to change each time the book name changes??
This will save me days of work each month!!
Yes, of course. But we can't tell what you're doing wrong without seeing
your code.
--
Jim Rech
Excel MVP
It almost seems that I need a macro to re-write this macro
900 times..........
For r = 3 To 900
Cells(r, 3).Select
Selection.Copy
Workbooks.Open FileName:="C:\My Documents\John
D's\01092.xls"
ActiveWindow.LargeScroll Down:=-1
ActiveWindow.LargeScroll ToRight:=-1
Range("E1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("PPC DSB codes v3.xls").Activate
Cells(r, 8).Select
ActiveSheet.Paste
Windows("01092.xls").Activate
ActiveWindow.LargeScroll Down:=1
Range("G39").Select
Application.CutCopyMode = False
Selection.Copy
Windows("PPC DSB codes v3.xls").Activate
Cells(r, 9).Select
ActiveSheet.Paste
Windows("01092.xls").Activate
ActiveWindow.LargeScroll ToRight:=1
Range("V39").Select
Application.CutCopyMode = False
Selection.Copy
Windows("PPC DSB codes v3.xls").Activate
Cells(r, 10).Select
ActiveSheet.Paste
Windows("01092.xls").Activate
ActiveWindow.Close
Next r
End Sub
>.
>
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Macros: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm
"john d" <mrjd...@hotmail.com> wrote in message news:1aaa801c22d7e$d664ba90$35ef2ecf@TKMSFTNGXA11...
I've started from scratch rather than modify your
original, so let me know if you can't see what's going on.
When you use the 'record macro' function, you often record
stuff that you don't really need such as window scrolls or
the selection of individual cells. I've removed this for a
start, and also created two new varables to store the two
worksheets- source and destination.
Sub DoStuff()
Const cSourceFolder = "C:\My Documents\John D's\"
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim r As Integer
'turn of screen updates to make things faster
Application.scren = False
'define master worksheet
Set wsDestination = ActiveSheet
For r = 3 To 900
'open source workbook, and assign to wsSource variable
Set wsSource = Workbooks.Open(cSourceFolder &
wsDestination.Cells(r, 1).Value).Worksheets(1)
'copy data across
wsSource.Range("E1").Copy
Destination:=wsDestination.Cells(r, 8)
wsSource.Range("G39").Copy
Destination:=wsDestination.Cells(r, 9)
wsSource.Range("V39").Copy
Destination:=wsDestination.Cells(r, 10)
'close source workbook
wsSource.Parent.Close savechanges:=False
Next r
Application.ScreenUpdating = True
End Sub
Cheers,
Dave.
>.
>
I have run this macro and it works, but almost inevitably your exact
circumstances are somewhat different and that causes problem. You can come
back with them and I or someone will try to remedy them.
Const SrcDir As String = "C:\My Documents\John D 's\"
Sub CopyRoutineForJohn()
Dim SrcRg As Range
Dim FileNameCell As Range
Dim Counter As Integer
Application.ScreenUpdating = False
Set SrcRg = Range(Range("A3"), Range("A3").End(xlDown))
On Error GoTo SomethingWrong
For Each FileNameCell In SrcRg
Counter = Counter + 1
Application.StatusBar = "Doing workbook " & Counter & " of " &
SrcRg.Cells.Count
Workbooks.Open SrcDir & FileNameCell.Value
Range("E1").Copy FileNameCell.Offset(0, 7)
Range("G39").Copy FileNameCell.Offset(0, 8)
Range("V39").Copy FileNameCell.Offset(0, 9)
ActiveWorkbook.Close False
Next
Application.StatusBar = False
Exit Sub
SomethingWrong:
MsgBox "Could not process " & FileNameCell.Value
End Sub
Yes, because you are using several workbooks, you do need to include a
way of varying the workbook name in your code. It may be an idea to
have the workbook name in column 1 and the sheet name in column 2 of
your master sheet.
You can copy/paste and then adapt the macro below (untested):-
'----------------------------------------------------------------------
Sub TRANSFER_VALUES()
Dim MasterSheet As Worksheet
Dim ToRow As Long
Dim MyBookName As String
Dim MySheetName As String
'-------------------------
Set MasterSheet = ThisWorkbook.Worksheets("Master")
ToRow = 1 'start at row 1 in the master sheet
'- go down master sheet rows until there is a blank in column A
'- (end of list)
While MasterSheet.Cells(ToRow, 1).Value <> ""
MyBookName = MasterSheet.Cells(ToRow, 1).Value & ".xls"
MySheetName = MasterSheet.Cells(ToRow, 2).Value
'- open workbook
Workbooks.Open Filename:=MyBookName
'- transfer value to column C
MasterSheet.Cells(ToRow, 3).Value =
Workbooks(MyBookName).Worksheets(MySheetName).Value
'- close workbook
Workbooks(MyBookName).Close savechanges:=False
'- go to next master row
ToRow = ToRow + 1
Wend
End Sub
'-- EOP ----------------------------------------------------------------
"john d" <mrjd...@hotmail.com> wrote in message news:<1aaa801c22d7e$d664ba90$35ef2ecf@TKMSFTNGXA11>...
sorry. the transfer line should be something like :-
MasterSheet.Cells(ToRow, 3).Value =
Workbooks(MyBookName).Worksheets(MySheetName).Range("A1").Value
(left the Range off)
regards
Brian B
-------------------------------------------------------------------------
"john d" <mrjd...@hotmail.com> wrote in message news:<1aaa801c22d7e$d664ba90$35ef2ecf@TKMSFTNGXA11>...