Google 網路論壇不再支援新的 Usenet 貼文或訂閱項目,但過往內容仍可供查看。

So nearly there.......

瀏覽次數:14 次
跳到第一則未讀訊息

john d

未讀,
2002年7月17日 清晨6:43:502002/7/17
收件者:
I have a macro, which I want to use to extract data (3
cells) from 900 worksheets into a master Doc.

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!!

Jim Rech

未讀,
2002年7月17日 清晨7:11:022002/7/17
收件者:
>>Is there a way of keeping the name of the target 'soft' ie it needs to
change each time the book name changes??

Yes, of course. But we can't tell what you're doing wrong without seeing
your code.


--
Jim Rech
Excel MVP


john d

未讀,
2002年7月17日 清晨7:32:442002/7/17
收件者:
The '01092' in the macro below is the name of book 1 ie
contents of Cell (R,1) - it is this that needs to be
updated with the cell (R,x)'s contents for each indexing
of the macro. You can see that unless the reference can be
changed automatically the macro keeps opening the first
book every time. Hope this makes sense.

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

>.
>

David McRitchie

未讀,
2002年7月17日 清晨7:42:202002/7/17
收件者:
Hi John,
See BuildTOC
http://www.mvps.org/dmcritchie/excel/buildtoc.htm

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...

Dave Ramage

未讀,
2002年7月17日 上午9:40:442002/7/17
收件者:
John,

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.

>.
>

Jim Rech

未讀,
2002年7月17日 上午9:56:592002/7/17
收件者:
I agree with Dave that recording macros gives you a load of extra baggage
that you don't need. I don't think his macro is complete however so I'll
offer you mine. Note that the macro assumes that the list of filenames
starts in cell A3 of the active sheet and extends in continous cells with no
breaks until the end down column A. It also assumes the file names have
file extensions like "File1.xls", not just "File1".

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

BrianB

未讀,
2002年7月17日 中午12:57:102002/7/17
收件者:
Hi John

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>...

BrianB

未讀,
2002年7月17日 下午1:02:052002/7/17
收件者:
Hi John

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>...

0 則新訊息