View Single Post
  #18   Report Post  
Posted to microsoft.public.excel.misc
Terry Pinnell[_4_] Terry Pinnell[_4_] is offline
external usenet poster
 
Posts: 192
Default Activate a workbook?

Terry Pinnell wrote:

GS wrote:

Oops! Pasted last line in the wrong order...

Sub CopyTrackSheetToWalkIndex_FromTMS3()
Dim wsSrc As Worksheet, wsTgt As Worksheet
Dim rngSrc As Range, rngTgt As Range
Dim v1, v2, n&

'Value-pair the Src|Tgt cell addresses
Const sSrcData$ = "B3|E2,B4|P2,B5|C2,B10|J2,B13|H2,B11|I2,B12|L2 " _
& "B17:B19|T2:V2,C17:C19|W2:Y2,D17:D19|Z2:AB2" _
& "E17:E19|AC2:AE2,F17:F19|AF2:AH2,G17:G19|AI2:A K2"
_
& "H17:H19|Q2:S2,I17:I19|?2:?2,J17:J19|M2:O2" _
& "B27:B28|AS2:AT2,B21:B22|AL2:AM2,B23:B24|AQ2:A R2"
v1 = Split(sSrcData, ",")

'Set fully qualified refs to Workbooks
'**Note this obviates need to ref ActiveWorkbook
Set wsSrc =
Workbooks("Test_CopyTrackSheet.xlsm").Sheets("Trac kData")
Set wsTgt = ThisWorkbook.Sheets("TEMP")

On Error GoTo Cleanup
For n = LBound(v1) To UBound(v1)
'Parse the Src|Tgt cell addresses
v2 = Split(v1(n), "|")
wsTgt.Range(v2(1)) = Application.Transpose(wsSrc.Range(v2(0)))
Next 'n

Cleanup:

Application.GoTo wsSrc.Cells(1)
Set wsSrc = Nothing: Set wsTgt = Nothing
End Sub 'CopyTrackSheetToWalkIndex_FromTMS3


Thanks for the follow-ups, Garry. I didn't understand your request
'Please move your textbox note so I can rewrite the code! Then repost a
link...'. Presumably you were referring to something in this?
https://dl.dropboxusercontent.com/u/...Copying-05.jpg
But as Claus's one-liner worked for me, pursuing your alternative more
complex method went on back burner ;-)

But curiosity is always a powerful motivator for me so I do intend to
try it as soon as possible.

Note that speed is not a relevant factor any more. The current VBA code
is pasted below, direct from VBE, so may need editing before running. It
processes all 40 cells in a fraction of a second. My Macro Express Pro
macro takes nearly 3 MINUTES.

However, your comment about VALUES got my attention. As you see from the
code comments, that's the next change I need to make.

Sub CopyTrackSheetToWalkIndex_Extract()
'VBA presently stored in Walk Index; may change later.
'Track sheet must be active at start (not Walk Index); may want to make
more flexible.
'40 cells copied to appropriate column of Walk Index. (THIS is an
arbitrary extract.)
'I17,I18,I19 contain a formula (simple average) so currently cause an
error on copying.
'Therefore need to convert these three to values before copying to
AN,AO,AP.
Application.EnableCancelKey = xlDisabled
With ThisWorkbook
With Sheets("Track Data")
.Range("B5").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("C2")
.Range("B10").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("J2")
'etc
'etc
.Range("I17").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("AN2")
.Range("I18").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("AO2")
'etc
'etc
.Range("B24").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("AR2")
End With
End With
With Workbooks("Walk Index.xlsm").Sheets("TEMP")
.Rows(3).Copy
.Rows(2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
End Sub

Here also is a a recent layout:
https://dl.dropboxusercontent.com/u/...Copying-06.jpg

Thanks again for your continuing help.

Terry, East Grinstead, UK


Hi Garry,

I've more progress since my post 40 mins ago. By prefacing the lines for
I17, 18 and 19 with an extra couple of lines suggested in the Excel
forum, pleased to report that I now get my values for the three
exceptions.

This is the VBA 'extract' now:

Sub CopyTrackSheetToWalkIndex_Extract()
'VBA presently stored in Walk Index; may change later.
'Track sheet must be active at start (not Walk Index); may want to make
more flexible.
'40 or so cells copied to appropriate column of Walk Index.
'At this stage I'm testing with row set to 2, but may later add code to
get it from clipboard.
'To fix the CODE EXECUTION INTERRUPTION message, added suggested first
line.
'Could re-enable that in the same execution by setting it to
xlInterrupt.
'Anyway it automatically re-enables when code execution finishes.
Application.EnableCancelKey = xlDisabled
With ThisWorkbook
With Sheets("Track Data")
.Range("B5").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("C2")
'etc
.Range("H17").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("Q2")
.Range("H18").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("R2")
.Range("H19").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("S2")
.Range("I17").Copy
Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("AN2").PasteSpec ial xlPasteValues
.Range("I18").Copy
Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("AO2").PasteSpec ial xlPasteValues
.Range("I19").Copy
Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("AP2").PasteSpec ial xlPasteValues
.Range("J17").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("M2")
.Range("J18").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("N2")
.Range("J19").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("O2")
'etc
.Range("B24").Copy Destination:=Workbooks("Walk
Index.xlsm").Sheets("TEMP").Range("AR2")
End With
End With
With Workbooks("Walk Index.xlsm").Sheets("TEMP")
.Rows(3).Copy
.Rows(2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
End Sub

The full macro in its present state is he
https://dl.dropboxusercontent.com/u/...ackSheet-1.txt

Terry, East Grinstead, UK