Automation Procedure with Worksheet_Activate

[If]

Hello,
I have the code below which becomes too long since I must go to line 200.
I would like to automate this procedure but I really do not see how.

The A6 cell of the "Finale" sheet must take again the data being in B3 on
the sheet "Data"
and the B6 cell of the "Finale" sheet must take again the data being in A3
on the "Data" sheet.

Procedure with cells(i, 1) with "for i =) ?????

Would somebody have a track?
Thank you for your assistance.


Private Sub Worksheet_Activate()
With Sheets("Finale")
..Range("A6") = Sheets("Data").Range("B3")
..Range("B6") = Sheets("Data").Range("A3")
..Range("C6") = Sheets("Data").Range("C3")
..Range("D6") = Sheets("Data").Range("D3")
..Range("E6") = Sheets("Data").Range("E3")
..Range("F6") = Sheets("Data").Range("F3")
..Range("G6") = Sheets("Data").Range("G3")
..Range("H6") = Sheets("Data").Range("H3")
..Range("I6") = Sheets("Data").Range("I3")
..Range("J6") = Sheets("Data").Range("J3")

..Range("C7") = Sheets("Data").Range("C4")
..Range("D7") = Sheets("Data").Range("D4")
..Range("E7") = Sheets("Data").Range("E4")
..Range("F7") = Sheets("Data").Range("F4")
..Range("G7") = Sheets("Data").Range("G4")
..Range("H7") = Sheets("Data").Range("H4")
..Range("I7") = Sheets("Data").Range("I4")
..Range("J7") = Sheets("Data").Range("J4")

- - - - -

End With
End Sub

 

[Patrick Molloy]

Two ways are possible

1)

Sheets("Finale").Range("A6:J6").Value = _
Sheets("Date").Range("A3:J3").Value

Sheets("Finale").Range("C7:J7").Value = _
Sheets("Date").Range("C4:J4").Value

2)
dim rw as long, cl as long
rw=3
for cl = 1 to 10
Sheets("Finale").Cells(rw+4,cl).Value = _
Sheets("Date").Cells(rw,cl).Value
next
rw = 4
for cl = 3 to 10
Sheets("Finale").Cells(rw+4,cl).Value = _
Sheets("Date").Cells(rw,cl).Value
next


depend sor your needs, but obviously (1) is faster

Patrick Molloy
Microsoft Excel MVP

 

[Peter Atherton]

Hello Yves

Have I missed something here? This seems to be just
copying block data from one sheet to another albeit in
slightly offset positions

Lets get some data to work with. Enter the following data
in sheet2, row 2 for the heading. Enter a sum Formula in
column F, SUM(A3:E3) and copy it into F4.

Now select the range from A3 to F4 and drag the selection
down to row 20. You should now have a good set of data to
workk with.


Original Data
1 2 3 4 5 15
2 3 4 5 6 20

There are three methods of coping data. We are copying the
values in sheet2 in range from A3 to F17 into sheet1 A6 to
f23

The copy method copies all contents over including
formulas. The same care should be taken in using this
method as in a worksheet. i.e. make sure you do not get a
reference error.

Copy syntax; declare the range to copy, declare the action
(copy) then declare the destination as in:
rng.Copy Target
rng is the range to be copied, copy is the action and
target is the destination of the copied data.

Sub CopyData()
Set rng = Sheets("Sheet2").Range("A3:F20")
Set Target = Worksheets(1).Range("A6")
rng.Copy Target
End Sub

The formula method only copies values. The formula (SUM)
in column F on sheet2 is not copied only the values.

Sub FormData()
Set rng = Sheets("Sheet2").Range("A3:F20")
Set Destination = Sheets("Sheet1").Range("A6:F23")
Destination.Value = rng.Value
End Sub

The for cells method takes a bit longer to perform but is
very flexible and can be used with step values to miss out
rows or columns. Definately worth mastering.

Sub CellsCopy()
Worksheets(1).Select 'or .Activate
For i = 6 To 23 'number of rows
For j = 2 To 7 'number of columns
'1) Destination cell is always shown on the left of
the equation.
'2) This time the data is copied to over a column as
well as three rows down.
'3) See how flexible 'the formula is just adding or as
in this case subtracting values.

Cells(i, j).Value = Worksheets(2).Cells(i - 3, j -
1).Value
Next j 'next column
Next i 'next row
End Sub

The copy cells method can be speeded up by declaring both
i and j as integers. It is usual to refer to the rows as i
and j for the columns. try the following program and
compare with the previous.

Sub CellCopy2()
Dim i As Integer, j As Integer
Worksheets("Sheet1").select
For i = 6 To 23 'number of rows
For j = 2 To 7 'number of columns
Cells(i, j).Value = Worksheets(2).Cells(i - 3, j -
1).Value
Next j 'next column
Next i 'next row
End Sub

You might not notice much difference with these but extend
the rows and columns of data and it becomes more noticable.

Hope this helps.
Regards
Peter

 

[If]

Thanks to All