Need help looping a macro (1 Viewer)

[Mr_Si]

Dear all,

I'm not used to programming in excel, but I have an issue where I need to transform data from one sheet (sheet 2) in to a different order on a different sheet (sheet 4) to enable me to enter data in to a database which is a specific format. The data is in specific cells so it's not a function to copy a row.

I have to copy data from Cell A5 on sheet 2 and paste it 12 times in to column
A on sheet 4. I then need to effectively transpose the data from cells N5 - Y5 from sheet 2 in to cells G1 - G12 on sheet 4.

I need to then repeat this action for each row in sheet 2.


My basic code from a simple recorded macro is as follows. It is not looped or Variabled at the moment but that's the issue I am trying to get help with.

Sub Macro2()
    Sheets("Sheet2").Select
    Range("A5").Select
    Selection.Copy
    Sheets("Sheet4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-1]C"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=R[-4]C"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "=R[-5]C"
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "=R[-6]C"
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "=R[-7]C"
    Range("A9").Select
    ActiveCell.FormulaR1C1 = "=R[-8]C"
    Range("A10").Select
    ActiveCell.FormulaR1C1 = "=R[-9]C"
    Range("A11").Select
    ActiveCell.FormulaR1C1 = "=R[-10]C"
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "=R[-11]C"
    Range("A13").Select
    Sheets("Sheet2").Select
    Range("N5").Select
    Selection.Copy
    Sheets("Sheet4").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("O5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("P5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("Q5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("g4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("R5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("g5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("S5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("g6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("T5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("g7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("U5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("g8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("V5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("g9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("W5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("g10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("X5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("g11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("Y5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("g12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

I look forward to your assistance and many thanks in advance.

 

[Mr_Si]

Don't worry all,

I worked it out:

Sub Copy()
    Dim I As Integer
    Dim Sheet2CurrentRow As Integer
    Dim Sheet5CurrentRow As Integer
    Dim RangeSelect As String

    
    'select starting row
    Sheet2CurrentRow = 5
    Sheet5CurrentRow = 1
    
    'start first loop here
    Do Until Sheet2CurrentRow = 146
        Sheets("Sheet2").Select
        RangeSelect = "A" & Sheet2CurrentRow
        Range(RangeSelect).Select
        Selection.Copy
    
        For I = 1 To 12
            Sheets("Sheet5").Select
            RangeSelect = "A" & Sheet5CurrentRow
            Range(RangeSelect).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Sheet5CurrentRow = Sheet5CurrentRow + 1
        Next
        
        Sheet2CurrentRow = Sheet2CurrentRow + 1
    Loop
             
    'start second loop here, this is in charge of doing a transposing paste
    Sheet2CurrentRow = 5
    Sheet5CurrentRow = 1
    
    Do Until Sheet2CurrentRow = 146
        Sheets("Sheet2").Select
        RangeSelect = "N" & Sheet2CurrentRow & ":Y" & Sheet2CurrentRow
        Range(RangeSelect).Select
        Selection.Copy
    
        'paste transpose in to sheet 5 cells
        Sheets("Sheet5").Select
        RangeSelect = "G" & Sheet5CurrentRow
        Range(RangeSelect).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
            False, transpose:=True
        
        'Increment rows to next relevant place
        Sheet5CurrentRow = Sheet5CurrentRow + 12
        Sheet2CurrentRow = Sheet2CurrentRow + 1
        
    Loop
    
End Sub

Sub TrackID()
    Dim I As Integer
    Dim Sheet5CurrentRow As Integer
    Dim RangeSelect As String
    
    Sheet5CurrentRow = 2
    
    Sheets("Sheet5").Select
    RangeSelect = "F" & Sheet5CurrentRow & ":F" & Sheet5CurrentRow + 11
    Range(RangeSelect).Select
    Selection.Copy
    
    For I = 1 To 140
        Sheet5CurrentRow = Sheet5CurrentRow + 12
        RangeSelect = "F" & Sheet5CurrentRow
        Range(RangeSelect).Select
        Selection.PasteSpecial Paste:=xlPasteValues
    Next
        
End Sub