View Single Post
  #30   Report Post  
Posted to microsoft.public.excel.misc
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default 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