VBA for copy/paste to different sheet with loop

[Kruggie]

Hi guys,

I'm new to VBA macros and cannot figure out a way to add a loop to my macro.
I have data output from an experiment and want to do the following:

1. Copy/paste data from sheet "Data" to sheet "Summary" (see below code).
2. Loop with an offset of 130 rows.
3. The paste function should select the next empty row on the "Summary" sheet.

My current sample contains 48 subjects, but there will be more at some point.

Any help would be very much appreciated.

Warm regards

Kruggie

Sub LM_data()


 'animal_ID
    Worksheets("Data").Range("C23").Copy Worksheets("Summary").Range("A2")


 'group
    Worksheets("Data").Range("C25").Copy Worksheets("Summary").Range("C2")

'1_dist_cm
    Worksheets("Data").Range("A99").Copy Worksheets("Summary").Range("D2")

'2_dist_cm
    Worksheets("Data").Range("A100").Copy Worksheets("Summary").Range("E2")


 'total_dist_cm
     Worksheets("Data").Range("A102").Copy Worksheets("Summary").Range("F2")

'1_amb_time
    Worksheets("Data").Range("B99").Copy Worksheets("Summary").Range("G2")

'2_amb_time
    Worksheets("Data").Range("B100").Copy Worksheets("Summary").Range("H2")

'total_amb_time
      Worksheets("Data").Range("B102").Copy Worksheets("Summary").Range("I2")

'1_rest_time
    Worksheets("Data").Range("F99").Copy Worksheets("Summary").Range("J2")

'2_rest_time
    Worksheets("Data").Range("F100").Copy Worksheets("Summary").Range("K2")

'total_rest_time
      Worksheets("Data").Range("F102").Copy Worksheets("Summary").Range("L2")

'zone_1_time
    Worksheets("Data").Range("J99").Copy Worksheets("Summary").Range("M2")

'zone_2_time
    Worksheets("Data").Range("J100").Copy Worksheets("Summary").Range("N2")

'total_time
       Worksheets("Data").Range("J102").Copy Worksheets("Summary").Range("O2")


End Sub

 

[footoo]

Sub LM_data()
Dim d As Variant, i%
d = Array("C23", "C25", "A99", "A100") 'Add required Data sheet cell refs (in required sequence)
For i = 0 To UBound(d)
    Worksheets("Data").Range(d(i)).Copy Worksheets("Summary").Cells(2, i + 1)
Next
End Sub

Edit : I've just noticed that B2 on Summary is skipped in your code. Is this correct or an error?

 

[Kruggie]

Sub LM_data()
Dim d As Variant, i%
d = Array("C23", "C25", "A99", "A100") 'Add required Data sheet cell refs (in required sequence)
For i = 0 To UBound(d)
    Worksheets("Data").Range(d(i)).Copy Worksheets("Summary").Cells(2, i + 1)
Next
End Sub

Edit : I've just noticed that B2 on Summary is skipped in your code. Is this correct or an error?

Thanks @footoo. Yes, B2 is skipped.

I've run the code:

Sub LM_data()
Dim d As Variant, i%
d = Array("C23", "C25", "A99", "A100", "A102", "B99", "B100", "B102", "F99", "F100", "F102", "J99", "J100", "J102") 'Add required Data sheet cell refs (in required sequence)
For i = 0 To UBound(d)
    Worksheets("Data").Range(d(i)).Copy Worksheets("Summary").Cells(2, i + 1)
Next
End Sub

but it only copies the first subject (same as my range.copy code). What's missing is the loop, where subsequent subjects are picked up. How do I achieve this?

 

[footoo]

[COLOR=#333333]but it only copies the first subject [/COLOR]

[COLOR=#333333]What's missing is the loop, where subsequent subjects are picked up.[/COLOR]

I don't understand what these two statements mean.

 

[Kruggie]

[COLOR=#333333]but it only copies the first subject [/COLOR]

[COLOR=#333333]What's missing is the loop, where subsequent subjects are picked up.[/COLOR]

I don't understand what these two statements mean.

There is data from 48 subjects in the sheet “Data”. The next subjects starts 130 rows after the first. I’d like to copy and paste the data from all 48 subjects to the sheet “Summary”.

 

[Kruggie]

[COLOR=#333333]but it only copies the first subject [/COLOR]

[COLOR=#333333]What's missing is the loop, where subsequent subjects are picked up.[/COLOR]

I don't understand what these two statements mean.

To illustrate where the next data is, I amended the code:

Sub LM_data()
Dim d As Variant, i%
d = Array("C153", "C155", "A229", "A230", "A232", "B229", "B230", "B232", "F229", "F230", "F232", "J229", "J230", "J232") '
For i = 0 To UBound(d)
    Worksheets("Data").Range(d(i)).Copy Worksheets("Summary").Cells(2, i + 1)
Next


End Sub

the next subject would be all cells in the array + 130 rows

makes sense?

 

[footoo]

There is data from 48 subjects in the sheet “Data”. The next subjects starts 130 rows after the first. I’d like to copy and paste the data from all 48 subjects to the sheet “Summary”.

Do you mean that you want to copy/paste C23 (for example) and then C153 (i.e. offset 130 rows down) ?
If so, how many times to repeat the offset - does each of the 48 "subjects" have the same number of rows ?

 

[Kruggie]

Do you mean that you want to copy/paste C23 (for example) and then C153 (i.e. offset 130 rows down) ?
If so, how many times to repeat the offset - does each of the 48 "subjects" have the same number of rows ?

Yes and yes

 

[footoo]

Sub LM_data()
Dim d As Variant, lr&, i%, x&
d = Array("C23", "C25", "A99", "A100", "A102", "B99", "B100", "B102", "F99", "F100", "F102", "J99", "J100", "J102")
Application.ScreenUpdating = False
Worksheets("Data").Select
lr = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For x = 0 To lr Step 130
    For i = 0 To UBound(d)
        Range(d(i)).Offset(x).Copy Worksheets("Summary").Cells(Rows.Count, i + 1).End(3)(2)
    Next
Next
End Sub

 

[Kruggie]

Sub LM_data()
Dim d As Variant, lr&, i%, x&
d = Array("C23", "C25", "A99", "A100", "A102", "B99", "B100", "B102", "F99", "F100", "F102", "J99", "J100", "J102")
Application.ScreenUpdating = False
Worksheets("Data").Select
lr = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For x = 0 To lr Step 130
    For i = 0 To UBound(d)
        Range(d(i)).Offset(x).Copy Worksheets("Summary").Cells(Rows.Count, i + 1).End(3)(2)
    Next
Next
End Sub

@footoo, that works like a charm. Thank you so much for your help