Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
I added a line
Workbooks("Walk Index.xlsm").Work.Activate at the end of my copying macro, to ensure that the workbook 'Walk Index' was in focus: -------------------- Sub CopyTrackSheetToWalkIndex() '40 or so cells copied to appropriate column of Walk Index. Sheets("Track Data").Range("B5").Copy Destination:=Workbooks("Walk Index.xlsm").Sheets("TEMP").Range("C2") Sheets("Track Data").Range("B10").Copy Destination:=Workbooks("Walk Index.xlsm").Sheets("TEMP").Range("J2") 'etc Workbooks("Walk Index.xlsm").Work.Activate End Sub -------------------- But it failed with the error Run-time error '438': Object doesn't support this property or method What was my mistake please? Terry, East Grinstead, UK |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Sat, 04 Mar 2017 10:05:24 +0000 schrieb Terry Pinnell: I added a line Workbooks("Walk Index.xlsm").Work.Activate at the end of my copying macro, to ensure that the workbook 'Walk Index' was in focus: try: Workbooks("Walk Index.xlsm").Activate Regards Claus B. -- Windows10 Office 2016 |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Sat, 04 Mar 2017 10:05:24 +0000 schrieb Terry Pinnell: I added a line Workbooks("Walk Index.xlsm").Work.Activate at the end of my copying macro, to ensure that the workbook 'Walk Index' was in focus: try: Workbooks("Walk Index.xlsm").Activate Regards Claus B. Hi Claus, Thanks, that works fine in the macro I posted. I actually made a minor edit to correct my mistake; it's the SOURCE workbook I want to activate, not the destination 'Walk Index.xlsm' To make the selected workbook more obvious (the windows look very similar in Windows 10) I then tried adding another line: Workbooks("TEST track sheet copying.xlsm").Activate Sheets("TEMP").Range(“A1”).Select But that failed. Also, on advice over in the Excel Forum, I've changed it to a neater version like this: Sub CopyTrackSheetToWalkIndex_FromTMS() 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("B22").Copy Destination:=Workbooks("Walk Index.xlsm").Sheets("TEMP").Range("AM2") .Range("B23").Copy Destination:=Workbooks("Walk Index.xlsm").Sheets("TEMP").Range("AQ2") .Range("B24").Copy Destination:=Workbooks("Walk Index.xlsm").Sheets("TEMP").Range("AR2") End With End With Workbooks("TEST track sheet copying.xlsm").Activate End Sub In this version the last line causes an error: Run-time error '9':Subscript out of range Terry, East Grinstead, UK |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Sat, 04 Mar 2017 19:17:52 +0000 schrieb Terry Pinnell: Workbooks("TEST track sheet copying.xlsm").Activate Sheets("TEMP").Range(“A1”).Select But that failed. try: Application.Goto Workbooks("TEST track sheet copying.xlsm").Sheets("TEMP").Range("A1") Regards Claus B. -- Windows10 Office 2016 |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
You may find the following a bit easier to maintain...
(I've used my naming convention for sheetnames/filenames so edit to suit) Sub CopyTrackSheetToWalkIndex_FromTMS2() Dim wbSrc As Workbook, wbTgt As Workbook Dim rngSrc As Range, rngTgt As Range Dim d1, d2, n& 'Exact-match the cell addresses Const sSrcData$ = "B5,B10,B22,B23,B24" d1 = Split(sSrcData, ",") Const sTgtData$ = "C2,J2,AM2,AQ2,AR2" d2 = Split(sTgtData, ",") 'Set fully qualified refs to Workbooks '**Note this obviates need to ref ActiveWorkbook Set wbSrc = ThisWorkbook Set wbTgt = Workbooks("WalkIndex.xlsm") On Error GoTo Cleanup For n = LBound(d1) To UBound(d1) wbTgt.Sheets("TEMP").Range(d2(n)) = wbSrc.Sheets("TrackData").Range(d1(n)) Next 'n Cleanup: Set wbSrc = Nothing: Set wbTgt = Nothing End Sub 'CopyTrackSheetToWalkIndex_FromTMS2 I don't know why you take action on TEST track sheet copying.xlsm here since it appears to be wbSrc. To activate its window... Windows("Test_CopyTrackSheet.xlsm").Activate **Note that my sample file uses my naming convention** -Optionally- Windows(ThisWorkbook.Name).Activate **Obviates hard-coding the filename** ...which is assumed to be already active! -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus, Garry,
Thanks both. Bedtime here, so will try those tomorrow morning. Terry, East Grinstead, UK |
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
GS wrote:
You may find the following a bit easier to maintain... (I've used my naming convention for sheetnames/filenames so edit to suit) Sub CopyTrackSheetToWalkIndex_FromTMS2() Dim wbSrc As Workbook, wbTgt As Workbook Dim rngSrc As Range, rngTgt As Range Dim d1, d2, n& 'Exact-match the cell addresses Const sSrcData$ = "B5,B10,B22,B23,B24" d1 = Split(sSrcData, ",") Const sTgtData$ = "C2,J2,AM2,AQ2,AR2" d2 = Split(sTgtData, ",") 'Set fully qualified refs to Workbooks '**Note this obviates need to ref ActiveWorkbook Set wbSrc = ThisWorkbook Set wbTgt = Workbooks("WalkIndex.xlsm") On Error GoTo Cleanup For n = LBound(d1) To UBound(d1) wbTgt.Sheets("TEMP").Range(d2(n)) = wbSrc.Sheets("TrackData").Range(d1(n)) Next 'n Cleanup: Set wbSrc = Nothing: Set wbTgt = Nothing End Sub 'CopyTrackSheetToWalkIndex_FromTMS2 I don't know why you take action on TEST track sheet copying.xlsm here since it appears to be wbSrc. To activate its window... Windows("Test_CopyTrackSheet.xlsm").Activate **Note that my sample file uses my naming convention** -Optionally- Windows(ThisWorkbook.Name).Activate **Obviates hard-coding the filename** ..which is assumed to be already active! This is going to need more studying on my part, Garry! Maybe I'll leave until next chapter of Walkenbach, on variables, before testing. So far I've got as far as turning it into text I can paste into the VBE without red error highlighting. Looks like this at the moment. https://dl.dropboxusercontent.com/u/...Copying-04.jpg Any thoughts on my earlier question on how to post code here so that it can be pasted directly with confidence? Must say this all seems mightily complex for what I thought was a fairly simple task! Terry, East Grinstead, UK |
#8
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Sat, 04 Mar 2017 19:17:52 +0000 schrieb Terry Pinnell: Workbooks("TEST track sheet copying.xlsm").Activate Sheets("TEMP").Range(“A1”).Select But that failed. try: Application.Goto Workbooks("TEST track sheet copying.xlsm").Sheets("TEMP").Range("A1") Regards Claus B. Now tested. Still gives me that subscript error, Claus. Here's my layout in case you see any clues. https://dl.dropboxusercontent.com/u/...Copying-05.jpg Terry, East Grinstead, UK |
#9
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Sun, 05 Mar 2017 08:07:48 +0000 schrieb Terry Pinnell: Now tested. Still gives me that subscript error, Claus. Here's my layout in case you see any clues. https://dl.dropboxusercontent.com/u/...Copying-05.jpg in workbook "TEST track sheet copying.xlsm" is only one sheet and that is named "Track Data"). Change the line to: Application.Goto Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data").Range("A1") Regards Claus B. -- Windows10 Office 2016 |
#10
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Sun, 05 Mar 2017 08:07:48 +0000 schrieb Terry Pinnell: https://dl.dropboxusercontent.com/u/...Copying-05.jpg here is another suggestion. I guess it is more readable. The ranges are not complete because it is only an example: Sub CpoyTrackSheet() Dim wbkS As Workbook, wbkD As Workbook Dim wshS As Worksheet, wshD As Worksheet Dim strS As String, strD As String Dim varSource As Variant, varDest As Variant Dim i As Integer Set wbkS = Workbooks("TEST track sheet copying.xlsm") Set wshS = wbkS.Sheets("Track Data") Set wbkD = ThisWorkbook Set wshD = wbkD.Sheets("TEMP") strS = "B5,B10,B3,B13,B11,B12,B17,B18,B19,C17,C18" varSource = Split(strS, ",") strD = "C2,J2,E2,H2,I2,L2,T2,U2,V2,M2,X2" varDest = Split(strD, ",") With wshD For i = LBound(varSource) To UBound(varSource) .Range(varDest(i)) = wshS.Range(varSource(i)) .Range(varDest(i)).NumberFormat = wshS.Range(varSource(i)).NumberFormat Next End With Application.Goto wshD.Range("A1") End Sub Regards Claus B. -- Windows10 Office 2016 |
#11
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
GS wrote:
You may find the following a bit easier to maintain... (I've used my naming convention for sheetnames/filenames so edit to suit) Sub CopyTrackSheetToWalkIndex_FromTMS2() Dim wbSrc As Workbook, wbTgt As Workbook Dim rngSrc As Range, rngTgt As Range Dim d1, d2, n& 'Exact-match the cell addresses Const sSrcData$ = "B5,B10,B22,B23,B24" d1 = Split(sSrcData, ",") Const sTgtData$ = "C2,J2,AM2,AQ2,AR2" d2 = Split(sTgtData, ",") 'Set fully qualified refs to Workbooks '**Note this obviates need to ref ActiveWorkbook Set wbSrc = ThisWorkbook Set wbTgt = Workbooks("WalkIndex.xlsm") On Error GoTo Cleanup For n = LBound(d1) To UBound(d1) wbTgt.Sheets("TEMP").Range(d2(n)) = wbSrc.Sheets("TrackData").Range(d1(n)) Next 'n Cleanup: Set wbSrc = Nothing: Set wbTgt = Nothing End Sub 'CopyTrackSheetToWalkIndex_FromTMS2 I don't know why you take action on TEST track sheet copying.xlsm here since it appears to be wbSrc. To activate its window... Windows("Test_CopyTrackSheet.xlsm").Activate **Note that my sample file uses my naming convention** -Optionally- Windows(ThisWorkbook.Name).Activate **Obviates hard-coding the filename** ..which is assumed to be already active! This is going to need more studying on my part, Garry! Maybe I'll leave until next chapter of Walkenbach, on variables, before testing. So far I've got as far as turning it into text I can paste into the VBE without red error highlighting. Looks like this at the moment. https://dl.dropboxusercontent.com/u/...Copying-04.jpg Any thoughts on my earlier question on how to post code here so that it can be pasted directly with confidence? Must say this all seems mightily complex for what I thought was a fairly simple task! Terry, East Grinstead, UK Ok, your pic says a lot more than your post! Code is in wsTgt (Walk Index.xlsm); ThisWorkbook applies to the file in which the running code resides! The source file (Test_CoppyTrackSheet.xlsm) is wsSrc; This contains Sheets("Track Data")! Please move your textbox note so I can rewrite the code! Then repost a link... -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#12
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Please move your textbox note so I can rewrite the code! Then repost
a link... The code in the VBE... -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#13
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Any thoughts on my earlier question on how to post code here so that
it can be pasted directly with confidence? Copy/Paste? Sometimes word-wrap plays into things, though, so you'll get red text in the VBE as a result. -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#14
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Sun, 05 Mar 2017 08:07:48 +0000 schrieb Terry Pinnell: Now tested. Still gives me that subscript error, Claus. Here's my layout in case you see any clues. https://dl.dropboxusercontent.com/u/...Copying-05.jpg in workbook "TEST track sheet copying.xlsm" is only one sheet and that is named "Track Data"). Change the line to: Application.Goto Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data").Range("A1") Regards Claus B. Excellent, that does it, thanks Claus! I have several additional questions about other edits I have to make ... but I'll leave you both in peace for a while ;-) Terry, East Grinstead, UK |
#15
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Ok, I have to move things along here and so I'll leave it up to you to
fill in the missing col labels for the Src|Tgt value pairs for I17:I19; -this is in line 4 of the cell addresses Const! Note that in my original solution I used 2 separate strings; works for short lists only! I prefer to use 1 string for longer lists to avoid mismatching. Note that the copy process requires way more overhead (and time) than just assigning values. Note that, unlike Copy, only the result (value) of source cells containing formulas gets assigned to the target, not the formula. Typically, summary sheets collect values only and so assignment is the way to go! 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: Set wsSrc = Nothing: Set wsTgt = Nothing Application.GoTo wsSrc.Cells(1) End Sub 'CopyTrackSheetToWalkIndex_FromTMS3 -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#16
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
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 -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#17
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
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 |
#18
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
#19
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Wed, 08 Mar 2017 09:51:48 +0000 schrieb Terry Pinnell: The full macro in its present state is he https://dl.dropboxusercontent.com/u/...ackSheet-1.txt try: Sub Test() Dim wshS As Worksheet, wshD As Worksheet Dim strS As String, strD As String Dim varS As Variant, varD As Variant Dim i As Integer, j As Integer strS = "B3,B4,B5,B11,B12,B13" strD = "E2,P2,C2,I2,L2,H2" varS = Split(strS, ",") varD = Split(strD, ",") Set wshS = ThisWorkbook.Sheets("Track Data") Set wshD = Workbooks("Walk Index.xlsm").Sheets("TEMP") With wshD For i = LBound(varS) To UBound(varS) .Range(varD(i)) = wshS.Range(varS(i)) Next .Range("M2:O2").Value = _ Application.Transpose(wshS.Range("J17:J19").Value) .Range("AS2:AT2").Value = _ Application.Transpose(wshS.Range("B27:B28").Value) .Range("AL2:AM2").Value = _ Application.Transpose(wshS.Range("B21:B22").Value) .Range("AQ2:AR2").Value = _ Application.Transpose(wshS.Range("B23:B24").Value) .Range("Q2:S2").Value = _ Application.Transpose(wshS.Range("H17:H19").Value) .Range("M2:O2").Value = _ Application.Transpose(wshS.Range("J17:J19").Value) .Range("AN2:AP2").Value = _ Application.Transpose(wshS.Range("I17:I19").Value) j = 20 For i = 2 To 7 .Cells(2, j).Resize(1, 3).Value = _ Application.Transpose(wshS.Cells(17, i).Resize(3, 1).Value) j = j + 3 Next End With End Sub Regards Claus B. -- Windows10 Office 2016 |
#20
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Wed, 08 Mar 2017 09:51:48 +0000 schrieb Terry Pinnell: The full macro in its present state is he https://dl.dropboxusercontent.com/u/...ackSheet-1.txt try: Sub Test() Dim wshS As Worksheet, wshD As Worksheet Dim strS As String, strD As String Dim varS As Variant, varD As Variant Dim i As Integer, j As Integer strS = "B3,B4,B5,B11,B12,B13" strD = "E2,P2,C2,I2,L2,H2" varS = Split(strS, ",") varD = Split(strD, ",") Set wshS = ThisWorkbook.Sheets("Track Data") Set wshD = Workbooks("Walk Index.xlsm").Sheets("TEMP") With wshD For i = LBound(varS) To UBound(varS) .Range(varD(i)) = wshS.Range(varS(i)) Next .Range("M2:O2").Value = _ Application.Transpose(wshS.Range("J17:J19").Value) .Range("AS2:AT2").Value = _ Application.Transpose(wshS.Range("B27:B28").Value) .Range("AL2:AM2").Value = _ Application.Transpose(wshS.Range("B21:B22").Value) .Range("AQ2:AR2").Value = _ Application.Transpose(wshS.Range("B23:B24").Value) .Range("Q2:S2").Value = _ Application.Transpose(wshS.Range("H17:H19").Value) .Range("M2:O2").Value = _ Application.Transpose(wshS.Range("J17:J19").Value) .Range("AN2:AP2").Value = _ Application.Transpose(wshS.Range("I17:I19").Value) j = 20 For i = 2 To 7 .Cells(2, j).Resize(1, 3).Value = _ Application.Transpose(wshS.Cells(17, i).Resize(3, 1).Value) j = j + 3 Next End With End Sub Thanks Claus. If a run that code I get the familiar 'Subscript out of range' error on this: Set wshS = ThisWorkbook.Sheets("Track Data") Please remember that I'm working largely in 'copy/paste mode' here, with limited understanding of how some of the VBA code actually works! But could the issue be that the Track data sheet is selected before the m,macro is run, but the code is in the TEMP worksheet? Terry, East Grinstead, UK |
#21
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
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 Just ran your amended code: Sub CopyTrackSheetToWalkIndexGarry() 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 I should have studied it first. It gave 'Subscript out of range' error on this line: Set wsSrc = Workbooks("Test_CopyTrackSheet.xlsm").Sheets("Trac kData") I assumed that was simply because that's no longer the name of the test workbook, which I changed last night to '201 TEST source track sheet.xlsm'. (The reason is that all practical worksheets on which I propose to run the macro begin with that string. I may later need to reflect that in the code.) But substituting that still gave the subscript error, on Set wsSrc = Workbooks("201 TEST source track sheet.xlsm").Sheets("TrackData") The cause of that was fairly easy to spot: the sheet is 'Track Data', not 'TrackData'. That then runs without an error, but does not deliver the expected result: https://dl.dropboxusercontent.com/u/...g-08-Garry.jpg Terry, East Grinstead, UK |
#22
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Wed, 08 Mar 2017 13:54:38 +0000 schrieb Terry Pinnell: If a run that code I get the familiar 'Subscript out of range' error on this: Set wshS = ThisWorkbook.Sheets("Track Data") then change the reference to: Set wshS = Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data") Set wshD = ThisWorkbook.Sheets("TEMP") Regards Claus B. -- Windows10 Office 2016 |
#23
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Wed, 08 Mar 2017 13:54:38 +0000 schrieb Terry Pinnell: Please remember that I'm working largely in 'copy/paste mode' here, with limited understanding of how some of the VBA code actually works! But could the issue be that the Track data sheet is selected before the m,macro is run, but the code is in the TEMP worksheet? you can also copy and PasteSpecial. Then the formats will be bopied too. But the macro is slower and you have display flickering nevertheless Screenupdating is set to false: Sub Test2() Dim wshS As Worksheet, wshD As Worksheet Dim strS As String, strD As String Dim varS As Variant, varD As Variant Dim i As Integer, j As Integer strS = "B3,B4,B5,B11,B12,B13" strD = "E2,P2,C2,I2,L2,H2" varS = Split(strS, ",") varD = Split(strD, ",") Set wshS = Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data") Set wshD = ThisWorkbook.Sheets("TEMP") Application.ScreenUpdating = False With wshD For i = LBound(varS) To UBound(varS) .Range(varD(i)) = wshS.Range(varS(i)) .Range(varD(i)).NumberFormat = wshS.Range(varS(i)).NumberFormat Next wshS.Range("J17:J19").Copy .Range("M2:O2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("B27:B28").Copy .Range("AS2:AT2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("B21:B22").Copy .Range("AL2:AM2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("B23:B24").Copy .Range("AQ2:AR2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("H17:H19").Copy .Range("Q2:S2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("J17:J19").Copy .Range("M2:O2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("I17:I19").Copy .Range("AN2:AP2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True j = 20 For i = 2 To 7 wshS.Cells(17, i).Resize(3, 1).Copy .Cells(2, j).Resize(1, 3).PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True j = j + 3 Next End With Application.ScreenUpdating = True End Sub Regards Claus B. -- Windows10 Office 2016 |
#24
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Keep in mind, as I stated earlier, that I used my naming convention for
testing. I assumed you'd pay attention to that this time around as well. Note that all data (except I17:I19) transferred correctly in my tests. -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#25
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Wed, 08 Mar 2017 13:54:38 +0000 schrieb Terry Pinnell: If a run that code I get the familiar 'Subscript out of range' error on this: Set wshS = ThisWorkbook.Sheets("Track Data") then change the reference to: Set wshS = Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data") Set wshD = ThisWorkbook.Sheets("TEMP") Regards Claus B. Hi Claus, Thanks. Although that now ran without error, as you see from my screenshot, B10 was not copied to J2. I tried editing strS = "B3,B4,B5,B11,B12,B13" to strS = "B3,B4,B5,B10,B11,B12,B13" but that gave a subscript out of range error on this line ..Range(varD(i)) = wshS.Range(varS(i)) which is further up the re-learning curve than I've reached ;-) Layout: https://dl.dropboxusercontent.com/u/...Copying-08.jpg I'm about to try your later code. Best wishes, Terry, East Grinstead, UK Thursday 9 March 2017, 0834 |
#26
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Wed, 08 Mar 2017 13:54:38 +0000 schrieb Terry Pinnell: Please remember that I'm working largely in 'copy/paste mode' here, with limited understanding of how some of the VBA code actually works! But could the issue be that the Track data sheet is selected before the m,macro is run, but the code is in the TEMP worksheet? you can also copy and PasteSpecial. Then the formats will be bopied too. But the macro is slower and you have display flickering nevertheless Screenupdating is set to false: Sub Test2() Dim wshS As Worksheet, wshD As Worksheet Dim strS As String, strD As String Dim varS As Variant, varD As Variant Dim i As Integer, j As Integer strS = "B3,B4,B5,B11,B12,B13" strD = "E2,P2,C2,I2,L2,H2" varS = Split(strS, ",") varD = Split(strD, ",") Set wshS = Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data") Set wshD = ThisWorkbook.Sheets("TEMP") Application.ScreenUpdating = False With wshD For i = LBound(varS) To UBound(varS) .Range(varD(i)) = wshS.Range(varS(i)) .Range(varD(i)).NumberFormat = wshS.Range(varS(i)).NumberFormat Next wshS.Range("J17:J19").Copy .Range("M2:O2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("B27:B28").Copy .Range("AS2:AT2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("B21:B22").Copy .Range("AL2:AM2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("B23:B24").Copy .Range("AQ2:AR2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("H17:H19").Copy .Range("Q2:S2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("J17:J19").Copy .Range("M2:O2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True wshS.Range("I17:I19").Copy .Range("AN2:AP2").PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True j = 20 For i = 2 To 7 wshS.Cells(17, i).Resize(3, 1).Copy .Cells(2, j).Resize(1, 3).PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=True j = j + 3 Next End With Application.ScreenUpdating = True End Sub Regards Claus B. Hi Claus, That ran without error too, but of course with B10 again not copied. Also, at its conclusion, G17:G19 were still selected (marquee around). Note that the only cells which *require* pasting as values are those specified earlier (I17,18,19 to AN,AO,AP). Also note that TEMP K3=J3*J4, so K2 gets entered by the lines With Workbooks("Walk Index.xlsm").Sheets("TEMP") .Rows(3).Copy .Rows(2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False of the earlier, fully-working version. That's my favourite, as I pretty well understand it! Best wishes, Terry, East Grinstead, UK |
#27
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Also note that TEMP K3=J3*J4, so K2 gets entered by the lines With Workbooks("Walk Index.xlsm").Sheets("TEMP") .Rows(3).Copy .Rows(2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False of the earlier, fully-working version. I was mistaken there, of course. The FORMAT gets copied but not the formula. Is there a change I can make to achieve that please? Otherwise I can do it manually. Terry, East Grinstead, UK |
#28
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Thu, 09 Mar 2017 09:33:00 +0000 schrieb Terry Pinnell: I was mistaken there, of course. The FORMAT gets copied but not the formula. Is there a change I can make to achieve that please? Otherwise I can do it manually. change xlPasteValuesAndNumberFormats to xlPasteAll Regards Claus B. -- Windows10 Office 2016 |
#29
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Thu, 09 Mar 2017 09:33:00 +0000 schrieb Terry Pinnell: I was mistaken there, of course. The FORMAT gets copied but not the formula. Is there a change I can make to achieve that please? Otherwise I can do it manually. change xlPasteValuesAndNumberFormats to xlPasteAll Regards Claus B. Hi Claus, On second thoughts it's probably easier to just enter the formula '=J3*24' into K2 of TEMP. Presumably using a statement at the end? So I'm now close to getting your 'streamlined' code fully working. Just leaves the question of how I change it to get the cell you missed, B10 (Duration) copied to J2, as per my earlier post: "...as you see from my screenshot, B10 was not copied to J2. I tried editing strS = "B3,B4,B5,B11,B12,B13" to strS = "B3,B4,B5,B10,B11,B12,B13" but that gave a subscript out of range error on this line ..Range(varD(i)) = wshS.Range(varS(i)) Best wishes, Terry, East Grinstead, UK |
#30
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Fri, 10 Mar 2017 10:01:35 +0000 schrieb Terry Pinnell: On second thoughts it's probably easier to just enter the formula '=J3*24' into K2 of TEMP. Presumably using a statement at the end? So I'm now close to getting your 'streamlined' code fully working. Just leaves the question of how I change it to get the cell you missed, B10 (Duration) copied to J2, as per my earlier post: if you add B10 to strS you also have to add J2 to strD: Sub Test2() Dim wshS As Worksheet, wshD As Worksheet Dim strS As String, strD As String Dim varS As Variant, varD As Variant Dim i As Integer, j As Integer strS = "B3,B4,B5,B10,B11,B12,B13" strD = "E2,P2,C2,J2,I2,L2,H2" varS = Split(strS, ",") varD = Split(strD, ",") Set wshS = Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data") Set wshD = ThisWorkbook.Sheets("TEMP") Application.ScreenUpdating = False With wshD For i = LBound(varS) To UBound(varS) .Range(varD(i)) = wshS.Range(varS(i)) .Range(varD(i)).NumberFormat = wshS.Range(varS(i)).NumberFormat Next wshS.Range("J17:J19").Copy .Range("M2:O2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("B27:B28").Copy .Range("AS2:AT2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("B21:B22").Copy .Range("AL2:AM2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("B23:B24").Copy .Range("AQ2:AR2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("H17:H19").Copy .Range("Q2:S2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("J17:J19").Copy .Range("M2:O2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("I17:I19").Copy .Range("AN2:AP2").PasteSpecial xlPasteAll, Transpose:=True j = 20 For i = 2 To 7 wshS.Cells(17, i).Resize(3, 1).Copy .Cells(2, j).Resize(1, 3).PasteSpecial xlPasteAll, Transpose:=True j = j + 3 Next .Range("K2").Formula = "=J3*24" End With Application.ScreenUpdating = True End Sub Regards Claus B. -- Windows10 Office 2016 |
#31
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
My apologies! I see now why it doesn't work for you. I split the cell
address string (after posting) to fit here without linewrap; -I replaced the commas when adding *" _* to the end of each line... 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|AN2:AP2,J17:J19|M2:O2," _ & "B27:B28|AS2:AT2,B21:B22|AL2:AM2,B23:B24|AQ2:A R2" ...and so expect yours would error out after putting B11 in I12. Replace this in my code. -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#32
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Fri, 10 Mar 2017 10:01:35 +0000 schrieb Terry Pinnell: On second thoughts it's probably easier to just enter the formula '=J3*24' into K2 of TEMP. Presumably using a statement at the end? So I'm now close to getting your 'streamlined' code fully working. Just leaves the question of how I change it to get the cell you missed, B10 (Duration) copied to J2, as per my earlier post: if you add B10 to strS you also have to add J2 to strD: Sub Test2() Dim wshS As Worksheet, wshD As Worksheet Dim strS As String, strD As String Dim varS As Variant, varD As Variant Dim i As Integer, j As Integer strS = "B3,B4,B5,B10,B11,B12,B13" strD = "E2,P2,C2,J2,I2,L2,H2" varS = Split(strS, ",") varD = Split(strD, ",") Set wshS = Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data") Set wshD = ThisWorkbook.Sheets("TEMP") Application.ScreenUpdating = False With wshD For i = LBound(varS) To UBound(varS) .Range(varD(i)) = wshS.Range(varS(i)) .Range(varD(i)).NumberFormat = wshS.Range(varS(i)).NumberFormat Next wshS.Range("J17:J19").Copy .Range("M2:O2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("B27:B28").Copy .Range("AS2:AT2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("B21:B22").Copy .Range("AL2:AM2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("B23:B24").Copy .Range("AQ2:AR2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("H17:H19").Copy .Range("Q2:S2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("J17:J19").Copy .Range("M2:O2").PasteSpecial xlPasteAll, Transpose:=True wshS.Range("I17:I19").Copy .Range("AN2:AP2").PasteSpecial xlPasteAll, Transpose:=True j = 20 For i = 2 To 7 wshS.Cells(17, i).Resize(3, 1).Copy .Cells(2, j).Resize(1, 3).PasteSpecial xlPasteAll, Transpose:=True j = j + 3 Next .Range("K2").Formula = "=J3*24" End With Application.ScreenUpdating = True End Sub Regards Claus B. Hi Claus, Much appreciate the fast reply. That fixes that query, but the copies of 'Best estimates' in J17, 18, 19 to AN, AO, AP now contain '=AVERAGE(#REF!)'. I expect it's obvious and I'll isolate the reason - but if you see this and get there first... ;-) Best wishes, Terry, East Grinstead, UK |
#33
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Much appreciate the fast reply. That fixes that query, but the copies of
'Best estimates' in J17, 18, 19 to AN, AO, AP now contain '=AVERAGE(#REF!)'. I expect it's obvious and I'll isolate the reason - but if you see this and get there first... ;-) This won't happen if you transfer values instead of copying! See my fix for the blooper I made of the cell address string... -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#34
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Fri, 10 Mar 2017 11:34:09 +0000 schrieb Terry Pinnell: Much appreciate the fast reply. That fixes that query, but the copies of 'Best estimates' in J17, 18, 19 to AN, AO, AP now contain '=AVERAGE(#REF!)'. I expect it's obvious and I'll isolate the reason - but if you see this and get there first... ;-) what do you need in TEMP? Do you need adapted formulas or do you need only the values? For values only try: Sub Test() Dim wshS As Worksheet, wshD As Worksheet Dim strS As String, strD As String Dim varS As Variant, varD As Variant Dim i As Integer, j As Integer strS = "B3,B4,B5,B10,B11,B12,B13" strD = "E2,P2,C2,J2,I2,L2,H2" varS = Split(strS, ",") varD = Split(strD, ",") Set wshS = Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data") Set wshD = ThisWorkbook.Sheets("TEMP") With wshD For i = LBound(varS) To UBound(varS) .Range(varD(i)) = wshS.Range(varS(i)) Next .Range("M2:O2").Value = _ Application.Transpose(wshS.Range("J17:J19").Value) .Range("AS2:AT2").Value = _ Application.Transpose(wshS.Range("B27:B28").Value) .Range("AL2:AM2").Value = _ Application.Transpose(wshS.Range("B21:B22").Value) .Range("AQ2:AR2").Value = _ Application.Transpose(wshS.Range("B23:B24").Value) .Range("Q2:S2").Value = _ Application.Transpose(wshS.Range("H17:H19").Value) .Range("M2:O2").Value = _ Application.Transpose(wshS.Range("J17:J19").Value) .Range("AN2:AP2").Value = _ Application.Transpose(wshS.Range("I17:I19").Value) j = 20 For i = 2 To 7 .Cells(2, j).Resize(1, 3).Value = _ Application.Transpose(wshS.Cells(17, i).Resize(3, 1).Value) j = j + 3 Next .Range("K2").Formula = "=J3*24" End With End Sub Regards Claus B. -- Windows10 Office 2016 |
#35
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Fri, 10 Mar 2017 11:34:09 +0000 schrieb Terry Pinnell: Much appreciate the fast reply. That fixes that query, but the copies of 'Best estimates' in J17, 18, 19 to AN, AO, AP now contain '=AVERAGE(#REF!)'. I expect it's obvious and I'll isolate the reason - but if you see this and get there first... ;-) what do you need in TEMP? Do you need adapted formulas or do you need only the values? For values only try: Sub Test() Dim wshS As Worksheet, wshD As Worksheet Dim strS As String, strD As String Dim varS As Variant, varD As Variant Dim i As Integer, j As Integer strS = "B3,B4,B5,B10,B11,B12,B13" strD = "E2,P2,C2,J2,I2,L2,H2" varS = Split(strS, ",") varD = Split(strD, ",") Set wshS = Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data") Set wshD = ThisWorkbook.Sheets("TEMP") With wshD For i = LBound(varS) To UBound(varS) .Range(varD(i)) = wshS.Range(varS(i)) Next .Range("M2:O2").Value = _ Application.Transpose(wshS.Range("J17:J19").Value) .Range("AS2:AT2").Value = _ Application.Transpose(wshS.Range("B27:B28").Value) .Range("AL2:AM2").Value = _ Application.Transpose(wshS.Range("B21:B22").Value) .Range("AQ2:AR2").Value = _ Application.Transpose(wshS.Range("B23:B24").Value) .Range("Q2:S2").Value = _ Application.Transpose(wshS.Range("H17:H19").Value) .Range("M2:O2").Value = _ Application.Transpose(wshS.Range("J17:J19").Value) .Range("AN2:AP2").Value = _ Application.Transpose(wshS.Range("I17:I19").Value) j = 20 For i = 2 To 7 .Cells(2, j).Resize(1, 3).Value = _ Application.Transpose(wshS.Cells(17, i).Resize(3, 1).Value) j = j + 3 Next .Range("K2").Formula = "=J3*24" End With End Sub Regards Claus B. Excellent, thanks a lot Claus! That now works a treat. Values was clearly the way to go.I can make changes of a simple nature, like adding more cells to be copied, based on your latest code. But, as you see here, I finally need to get all the size 12 text to size 10. Some columns (M onwards) have inherited the source size, 12. https://dl.dropboxusercontent.com/u/...lausValues.jpg I've been handling that with these two lines at the end: ..Rows(3).Copy ..Rows(2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False But that requires keeping a 'template row' on the destination sheet, which is not very elegant. Is there a statement I can add that simply makes row 2 all Arial size 10 please? Best wishes, Terry, East Grinstead, UK |
#36
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi Terry,
Am Fri, 10 Mar 2017 15:54:54 +0000 schrieb Terry Pinnell: But, as you see here, I finally need to get all the size 12 text to size 10. Some columns (M onwards) have inherited the source size, 12. https://dl.dropboxusercontent.com/u/...lausValues.jpg change the code at the end to: Next .Range("K2").Formula = "=J3*24" .Rows(2).Font.Size = 10 Regards Claus B. -- Windows10 Office 2016 |
#37
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Hi again,
Am Fri, 10 Mar 2017 17:01:41 +0100 schrieb Claus Busch: Next .Range("K2").Formula = "=J3*24" .Rows(2).Font.Size = 10 if you also want to change the font type try this at the end of the code: Next .Range("K2").Formula = "=J3*24" With .Rows(2).Font .Size = 10 .Name = "Arial" End With End With End Sub Regards Claus B. -- Windows10 Office 2016 |
#38
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Claus Busch wrote:
Hi Terry, Am Fri, 10 Mar 2017 15:54:54 +0000 schrieb Terry Pinnell: But, as you see here, I finally need to get all the size 12 text to size 10. Some columns (M onwards) have inherited the source size, 12. https://dl.dropboxusercontent.com/u/...lausValues.jpg change the code at the end to: Next .Range("K2").Formula = "=J3*24" .Rows(2).Font.Size = 10 Regards Claus B. I'm there, thank you so much Claus! I've been 90% in 'copy/paste mode' and 10% in 'learning mode', so I've greatly appreciated your patience in stepping me through all that. Now to spend a few hours/days/weeks *understanding* all the code contributed by you and Garry ;-) Can't promise I won't be back for more! Best wishes, Terry, East Grinstead, UK |
#39
Posted to microsoft.public.excel.misc
|
|||
|
|||
Activate a workbook?
Terry Pinnell wrote:
Claus Busch wrote: Hi Terry, Am Fri, 10 Mar 2017 15:54:54 +0000 schrieb Terry Pinnell: But, as you see here, I finally need to get all the size 12 text to size 10. Some columns (M onwards) have inherited the source size, 12. https://dl.dropboxusercontent.com/u/...lausValues.jpg change the code at the end to: Next .Range("K2").Formula = "=J3*24" .Rows(2).Font.Size = 10 Regards Claus B. I'm there, thank you so much Claus! I've been 90% in 'copy/paste mode' and 10% in 'learning mode', so I've greatly appreciated your patience in stepping me through all that. Now to spend a few hours/days/weeks *understanding* all the code contributed by you and Garry ;-) Can't promise I won't be back for more! Best wishes, Terry, East Grinstead, UK How would I edit this line in Claus's final macro Set wshS = Workbooks("TEST track sheet copying.xlsm").Sheets("Track Data") so that the macro will work with any workbook with a name starting with '201' please? For example, '20170314Godstone-B-e381-m4.7.xlsm', etc. Alternatively, as I always start the macro with the Track Data worksheet selected in that source workbook, can I capture its name there and then use it in the line above? Best wishes, Terry, East Grinstead, UK |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Workbook activate help | Excel Programming | |||
Activate a Workbook | Excel Programming | |||
Activate WorkBook | Excel Programming | |||
Activate WorkBook | Excel Programming | |||
Workbook.Activate / Window.Activate problem | Excel Programming |