Copy, past, formulas, loop

[Aftermaind]

Hi,

I'm trying to make a macro for this file but i can figure it out to work.

I want to copy the values from "Final"sheet (column B, C and D) to sheet 1 in cells (C,2);(C,3);(C,4) and the result (G3 to L3) i want to insert it back to sheet "Final"
I need a loop to do this for a large range of rows (over 25000). I have attached a sample file.

Best regards,

test.xlsx

[mehmetcik]

this will be very slow
please post an example

[mehmetcik]

Please Login or Register  to view this content.

[Aftermaind]

Why in the sheet1 the range in ("B200:E2700")?

I only need to insert the data in C2 - C5 and colect it from G3 - L3

Ex: How it is made manualy step by step

1. Copy value from A2("Final" sheet) in to C2("heet1")
2. Copy value from B2("Final" sheet) in to C3("heet1")
3. Copy value from C3("Final" sheet) in to C4("heet1")
4. Observ result in to cells G3-L3("sheet1")
5. Copy each value from the cells above to cells E2 - J2("Final" sheet) in that order

I've attach an example

The red cells are the values and the blue cells are the result
Red value have to be copy from Final to Sheet 1
Blue result have to be copy from Sheet 1 to Final

test1.xlsx

[Aftermaind]

How can condition this macro to go only the the last cell field of the column?

ActiveCell.Offset.Range("A1:C1").Select
Selection.Copy
Sheets("Input Worksheet").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("G3:L3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Final").Select
ActiveCell.Offset.Range("D1:I1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -3).Range("A2").Select

[Aftermaind]

[SOLVED] You can close the thread


Sub Macro6()

Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))

ActiveCell.Offset.Range("A1:C1").Select
Selection.Copy
Sheets("Input Worksheet").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("G3:L3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Final").Select
ActiveCell.Offset.Range("D1:I1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -3).Range("A2").Select


Loop


End Sub