copy cells from range "C3" to "F3" with loop and blank field

[Masterm]

Hi ,
I have recorded this macro ,but I do not know how many times I do have to repeat this I am quite new to VBA for excel
so I try to explain to you what I would like.
I have a xml file , which I inject into a excel 2010 file so far so good , but the lay-out is wrong I only need the "C" row because there are the info which I need , but in the wrong order , it always starts at "C3"
and I also need the next field "C4" .
but I need "C3" on "F3" and "C4" on "G3" next to each other and then there is a blank "C5" ( which I do not need)
but I need "C6" on "F6" and "C7" on "G6" and "C8" is a blank again and so on
and this until the end which could be anything , at one point the "C" row will be empty , so something like loop it until 3 blank fields on "C"
would do the trick.
I have recorded something like this
Range ("C3").Select
Selection.Copy
Range ("F3").Select
ActiveSheet.Paste
Range ("C4").Select
Application.CutCopyMode = False
Selection.Copy
Range ("G3").Select
ActiveSheet.Paste
Range ("C6").Select
Selection.Copy
Range ("F6").Select
ActiveSheet.Paste
Range ("C7").Select
Application.CutCopyMode = False
Selection.Copy
Range ("G6").Select
ActiveSheet.Paste

and so on
but looping it with always 1 blank in between is not so easy for me , and just keep recording the macro until 2000 or 3000 times
I think the must be an easier way, I have been try and looking it up via google , but couldn't find anything which fits my needs
so if someone has an idea this would be nice thanks

 

[BarryL]

try the below. might be a bit too simple.

Sub C3()
Dim i As Long, lr As Long
lr = Range("C" & Rows.Count).End(xlUp).Row
For i = 3 To lr Step 3
Range("C" & i).Offset(0, 3).Value = Range("C" & i).Value
Range("C" & i).Offset(0, 4).Value = Range("C" & i).Offset(1, 0).Value
Next i
End Sub

 

[Fishboy]

Hi ,
I have recorded this macro ,but I do not know how many times I do have to repeat this I am quite new to VBA for excel
so I try to explain to you what I would like.
I have a xml file , which I inject into a excel 2010 file so far so good , but the lay-out is wrong I only need the "C" row because there are the info which I need , but in the wrong order , it always starts at "C3"
and I also need the next field "C4" .
but I need "C3" on "F3" and "C4" on "G3" next to each other and then there is a blank "C5" ( which I do not need)
but I need "C6" on "F6" and "C7" on "G6" and "C8" is a blank again and so on
and this until the end which could be anything , at one point the "C" row will be empty , so something like loop it until 3 blank fields on "C"
would do the trick.
I have recorded something like this
Range ("C3").Select
Selection.Copy
Range ("F3").Select
ActiveSheet.Paste
Range ("C4").Select
Application.CutCopyMode = False
Selection.Copy
Range ("G3").Select
ActiveSheet.Paste
Range ("C6").Select
Selection.Copy
Range ("F6").Select
ActiveSheet.Paste
Range ("C7").Select
Application.CutCopyMode = False
Selection.Copy
Range ("G6").Select
ActiveSheet.Paste

and so on
but looping it with always 1 blank in between is not so easy for me , and just keep recording the macro until 2000 or 3000 times
I think the must be an easier way, I have been try and looking it up via google , but couldn't find anything which fits my needs
so if someone has an idea this would be nice thanks

Hi Masterm, welcome to the boards.

The following code should do the trick, and the only assumption it makes is that there is a header value of some sort in cell F2 allowing us to define LastRow. You can amend the C3:C20 check range to suit your data. Try it out in a COPY of your workbook:

Sub RedesignLayout()
' Defines variables
Dim Cell As Range, cRange As Range
' Defines LastRow as first row of column F below headers (assumes there is a header value in F2)
LastRow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row + 1
' Sets range to check as C3:C20 (update as required)
Set cRange = Range("C3:C20")
' For each cell in check range
    For Each Cell In cRange
' If the cell value is not blank then...
        If Cell.Value <> "" Then
' Copy the cell
            Cell.Copy
' If column F and LastRow is blank then paste to it
                If Range("F" & LastRow).Value = "" Then
                    Range("F" & LastRow).Select
                        ActiveSheet.Paste
' Else if column F and LastRow is not blank then paste to G and LastRow
                Else: Range("G" & LastRow).Select
                    ActiveSheet.Paste
' Increase LastRow by 2 to account for both F and G being pasted to
                        LastRow = LastRow + 2
                End If
        End If
' Check next cell in check range
    Next Cell
End Sub

try the below. might be a bit too simple.

Sub C3()
Dim i As Long, lr As Long
lr = Range("C" & Rows.Count).End(xlUp).Row
For i = 3 To lr Step 3
Range("C" & i).Offset(0, 3).Value = Range("C" & i).Value
Range("C" & i).Offset(0, 4).Value = Range("C" & i).Offset(1, 0).Value
Next i
End Sub

Barry, I suspect this does not account for the blank cells correctly. Is it not adding in 2 blank rows instead of one?

 

[Masterm]

thanks both work fine for my needs , thanks again Fishboy and BarryL

 

[Fishboy]

thanks both work fine for my needs , thanks again Fishboy and BarryL

Happy to help mate