Speed up code

[craigg3]

Is there anyway to speed up how Im doing this? I have more code like this but only posted a portion of it. Takes about 5 seconds to run the macro, would really like to lower that time.

ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B1
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B2
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B3
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B4
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B5
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B6
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B7
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B8
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B9
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B10
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B11
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B12
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B13
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B14
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = B15
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L1
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L2
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L3
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L4
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L5
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L6
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L7
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L8
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L9
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L10
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L11
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L12
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L13
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L14
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = L15

 

[mumps]

Can you explain in words what you are trying to do using a few examples?

 

[Fluff]

What are B1, B2 etc. Also what is the active cell to start with?

 

[craigg3]

Sorry for not explaining more. B1, B2 etc are variables such as
B1=Sheets("Sheet1").range("a2").value
B2=Sheets("Sheet1").range("b2").value
B3=Sheets("Sheet1").range("c2").value
B4=Sheets("Sheet1").range("a3").value
B5=Sheets("Sheet1").range("b3").value
B6=Sheets("Sheet1").range("c3").value
etc.....

I have a form on a sheet that a person fills out and then when they click the submit button it is copied to another sheet.

 

[Fluff]

You could use something like

   With ActiveCell
      .Offset(, 1).Resize(, 3).Value = Sheets("Sheet1").Range("A2:C2").Value
      .Offset(, 4).Resize(, 3).Value = Sheets("sheet1").Range("A3:C3").Value
   End With

But without knowing exactly where all the values come from & what you are trying to do, it's difficult to help much further.

 

[Rick Rothstein]

Sorry for not explaining more. B1, B2 etc are variables such as
B1=Sheets("Sheet1").range("a2").value
B2=Sheets("Sheet1").range("b2").value
B3=Sheets("Sheet1").range("c2").value
B4=Sheets("Sheet1").range("a3").value
B5=Sheets("Sheet1").range("b3").value
B6=Sheets("Sheet1").range("c3").value
etc.....

I have a form on a sheet that a person fills out and then when they click the submit button it is copied to another sheet.

Assuming the B1, B2, etc. that you are assigning to is on Sheet2, give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub RearrangeData()
  Dim LastRow As Long, Arr As Variant
  LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
  Arr = Split(Join(Application.Transpose(Evaluate(Replace("Sheet1!A2:A#&CHAR(10)&Sheet1!B2:B#&CHAR(10)&Sheet1!C2:C#", "#", LastRow))), vbLf), vbLf)
  Sheets("[B][COLOR="#0000FF"]Sheet2[/COLOR][/B]").Range("B2").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
End Sub[/td]
[/tr]
[/table]