Need to index every fifth column to a single column

Question

Hi, I have four columns of data types that will repeat with a space between. They will all need to put into single columns on a different sheet, so column A should have column F under it, and column K should be under that, and so on. Column B will have column G under it and L under that. The number of times it repeats can alter depending on the project, so I will need to be able to edit it easily. The number of rows will be consistent throughout the columns, but that number needs to be flexible also. I hope I explained it well enough.

Thank you.

hansvogelaar · Answer

wass024&nbsp;
Here is a macro you can run:
Sub MoveData()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim r As Long
    Dim m As Long
    Dim c As Long
    Dim n As Long
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    Set wt = Worksheets.Add(After:=ws)
    m = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    n = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    r = 1
    For c = 1 To n Step 5
        wt.Cells(r, 1).Resize(m, 4).Value = ws.Cells(1, c).Resize(m, 4).Value
        r = r + m
    Next c
    Application.ScreenUpdating = True
End Sub

jmb17 · Answer

wass024&nbsp;&nbsp;Assuming the data in your worksheet are constant values, and not formulas, then I believe this would work as well.&nbsp;Sub CopyData()
     Dim area As Range
     Dim srcWksht As Worksheet
     Dim destWksht As Worksheet
     
     Set srcWksht = ActiveSheet
     Set destWksht = Worksheets.Add(after:=srcWksht)
     
     For Each area In srcWksht.UsedRange.SpecialCells(xlCellTypeConstants).Areas
          area.Copy destWksht.Cells(destWksht.Rows.Count, 1).End(xlUp)(2, 1)
     Next area
     
End Sub

wass024 · Answer

HansVogelaar&nbsp;Amazing!!!! Thank you so much.&nbsp; How can I get the macro to overwrite the worksheet each time I update it instead of creating a new worksheet?&nbsp;Thanks.

hansvogelaar · Answer

wass024&nbsp;
The following version will write the data to a sheet named Result.
If it does not exist yet, it will be created.
If it already exists, it will be cleared first.
You can change the name in the code.
Sub MoveData()
    ' Name for the sheet with the result
    ' Change to your own preference
    Const TargetName = "Result"
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim r As Long
    Dim m As Long
    Dim c As Long
    Dim n As Long
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    On Error Resume Next
    Set wt = Worksheets(TargetName)
    On Error GoTo 0
    If wt Is Nothing Then
        Set wt = Worksheets.Add(After:=ws)
        wt.Name = TargetName
    Else
        wt.UsedRange.Clear
    End If
    m = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    n = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    r = 1
    For c = 1 To n Step 5
        wt.Cells(r, 1).Resize(m, 4).Value = ws.Cells(1, c).Resize(m, 4).Value
        r = r + m
    Next c
    Application.ScreenUpdating = True
End Sub

Forum Discussion

Need to index every fifth column to a single column

4 Replies

Resources