VBA Looping through columns (copy and paste)

[DemolitionMech]

Hello,

New to VBA. I am currently having trouble going through column names in order, and copy and pasting them to a location. Basically, I have data in cells F1:F7 , G1:G7, H1:H7 , etc. and I would like to paste those values one at a time underneath each other in column A (moving to the right).

I have gotten this to work with this formula -

Sub CopyDown()
Dim c As Long
Do
c = c + 1
Range("F1:F7").Copy Range("A" & Rows.Count).End(xlUp)(2)
Range("G1:G7").Copy Range("A" & Rows.Count).End(xlUp)(2)
Range("H1:H7").Copy Range("A" & Rows.Count).End(xlUp)(2)
Loop Until c = 1
End Sub

However, the problem is that I have over 130 columns of data. So I am not trying to write out - Range("K1:K7").Copy Range("A" & Rows.Count).End(xlUp)(2) - over and over 130 times.
I was wondering how I would loop this properly and still accomplish my goal.

Any help is much appreciated, thank you!
-Matt

 

[offthelip]

try this code:

Sub test2()
inarr = Range(Cells(1, 1), Cells(7, 130))
outarr = Range(Cells(1, 1), Cells(7 * 130, 1))
xx = 1
For i = 6 To 130
 For j = 1 To 7
  outarr(xx, 1) = inarr(j, i)
  xx = xx + 1
 Next j
Next i
Range(Cells(1, 1), Cells(7 * 130, 1)) = outarr

End Sub

 

[JLGWhiz]

Sub t()
Dim i As Long
    For i = 6 To Cells(1, Columns.Count).End(xlToLeft).Column
        If Application.CountA(Cells(1, i).Resize(7)) <> 0 Then
            Cells(1, i).Resize(7).Copy Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    Next
End Sub

 

[DemolitionMech]

These worked great! Thank you again!!

 

[JLGWhiz]

Glad we could help.
regards, JLG