CODEWITHSUNDEEP
vbaexcel
user3214725
user3214725

Reputation: 17

loop through cells and copy data to the next 5 cells if there is data

good afternoon,

I have a worksheet where I need a macro to copy the value from D1 and paste it to the next 5 cells (paste it to E1:I1), then if the next cell has data (J1) copy it and paste it to the next five cells etc. until the next cell is blank (the problem is that every time this spreadsheet has a different number of columns). I did try to do this with macro recorder but I have to set every time the cells that I want to copy the data from and the cells that I will paste them to. There must be an easier way than this, any help would be appreciated. Range("D1").Select Selection.Copy Range("E1:I1").Select ActiveSheet.Paste Range("J1").Select Application.CutCopyMode = False Selection.Copy Range("K1").Select ActiveWindow.SmallScroll ToRight:=10 Range("K1:O1").Select ActiveSheet.Paste Range("P1").Select Application.CutCopyMode = False Selection.Copy Range("Q1:U1").Select ActiveSheet.Paste Range("V1").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll ToRight:=12 Range("W1").Select ActiveSheet.Paste Range("X1:AA1").Select ActiveSheet.Paste Range("AB1").Select Application.CutCopyMode = False Selection.Copy Range("AC1:AG1").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=8 Range("AH1").Select Application.CutCopyMode = False Selection.Copy Range("AI1:AM1").Select ActiveSheet.Paste Range("AN1").Select Application.CutCopyMode = False Selection.Copy Range("AO1:AS1").Select ActiveSheet.Paste

Upvotes: 0

Views: 2191

Answers (4)

Ambie
Ambie

Reputation: 4977

You'd need to run some form of loop. There are several kinds: For ... Next, Do Until ..., etc. Have a read about them (http://www.excelfunctions.net/VBA-Loops.html) and you'll see they give you great versatility.

In your case, one of many solutions could be as follows:

' Adjust these values to suit
Const SHEET_NAME As String = "Sheet1" 'name of sheet
Const START_COLUMN As String = "D" 'column letter where routine starts
Const ROW_NUM As Long = 1 'row number of your data
Const COPY_SIZE As Integer = 5 'number of columns to copy the data
Dim rng As Range

' The looping routine
Set rng = ThisWorkbook.Worksheets(SHEET_NAME).Cells(ROW_NUM, START_COLUMN)
Do Until IsEmpty(rng)
    rng.Offset(, 1).Resize(, COPY_SIZE) = rng.Value2
    Set rng = rng.Offset(, COPY_SIZE + 1)
Loop

Upvotes: 1

A.S.H
A.S.H

Reputation: 29352

Sub mySub()
    Dim src As Range: Set src = ActiveSheet.Range("D1")
    Dim dest As Range: Set dest = ActiveSheet.Range("E1:I1")
    Do Until Trim(src.Text) = vbNullString
        src.Copy dest
        Set src = src.Offset(, 6): Set dest = dest.Offset(, 6)
    Loop
End Sub

Upvotes: 1

Parfait
Parfait

Reputation: 107687

Consider the following to first find the last column in spreadsheet and iterate every 5 columns using Cells(r, c) reference for numbering:

Sub CopyNextFive()

    LastColumn = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column

    For i = 4 To LastColumn Step 6
        Cells(1, i).Copy
        Range(Cells(1, i + 1), Cells(1, i + 5)).PasteSpecial xlPasteAll            
    Next i        
    Application.CutCopyMode = False       

End Sub

Upvotes: 1

Tim
Tim

Reputation: 2902

I would do this by using RC notation and looping something like this:

dim myValue
dim c as integer
dim x as integer

c=4 'Start in column D
myValue = cells(1,c).value 'Row 1 of column D
while myValue <> ""
    for x = 1 to 5
        cells(1,c+x).value=myValue
    next x
    c=c+x+1 'To give us the 10th column: J
    myValue = cells(1,c).value
wend

Upvotes: 1

Related Questions