1

I want to loop through 8 columns(A-H) in sheet 1 to make one new column in sheet 2. Then loop through 8 columns again(I-P) and make column B in sheet 2. I have do this for a lot of data and think this would be the best way to do it

here is my code

Range("E5").Select
Range(Selection, Selection.End(xlDown)).Select
Range("E5").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-96
Range("E5:E110").Select
Selection.Copy
Sheets("56 J").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("56 g").Select

Range("F5").Select
Range(Selection, Selection.End(xlDown)).Select
Range("F5").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-96
Range("F5:F110").Select
Selection.Copy
Sheets("56 J").Select
Range("A110").Select
ActiveSheet.Paste
Sheets("56 g").Select

any idea how I can put this in something that loops through the columns?

enter image description here

This is an example of what I am trying to do.I would also like to have the time and letter stay with the corresponding data when it loops. But my main focus right now is just getting the data into a single column.

  • What have you tried? Have you looked up threads/tutorials on loops? Also, it's best to avoid using [`.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). Looking in to that will help you get in the mindset for variables, etc. – BruceWayne Nov 20 '17 at 22:13
  • Provide an example of the data and the desired output. – user115014 Nov 20 '17 at 22:17
  • See the second answer here: https://stackoverflow.com/questions/20541905/convert-matrix-to-3-column-table-reverse-pivot-unpivot-flatten-normal – Scott Craner Nov 20 '17 at 22:41

2 Answers2

0

You should be able to loop through the source and destination columns with a little maths.

Dim c As Long, n As Long, tws As Worksheet

Set tws = Worksheets("56 j")

With Worksheets("56 g")
    For n = 1 To 2
        For c = 1 To 8
            With .Range(.Cells(5, c + (n - 1) * 8), .Cells(.Rows.Count, c + (n - 1) * 8).End(xlUp))
                tws.Cells(tws.Rows.Count, n).End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count) = .Value
            End With
        Next c
    Next n
End With
0
Option Explicit
Sub copydata()
Dim WS1, WS2 As Worksheet
Dim lastrow As Long
Dim ws1Row, ws2Row As Long
Dim mycol As Integer

Set WS1 = Worksheets("sheet1")
Set WS2 = Worksheets("sheet2")
lastrow = WS1.Cells(WS1.Rows.Count, "A").End(xlUp).Row
ws2Row = 2
For ws1Row = 5 To lastrow
    For mycol = 1 To 8
        WS2.Cells(ws2Row, 1) = WS1.Cells(ws1Row, mycol)
        WS2.Cells(ws2Row, 2) = WS1.Cells(ws1Row, mycol + 8)
        ws2Row = ws2Row + 1
    Next mycol
Next ws1Row
End Sub
Carol
  • 471
  • 4
  • 7