copy loop

[paulntee]

I need to copy a range of say 5 cells from A1:A5 to C1:C5 Then repeat for the next 5 rows, repeat for next 5, until no more data (actually I want to transpose the data from vert to horizontal, but I can do that part myself) I want to use a relative reference for this and am having trouble getting a loop to work and increment the positions correctly. Please help - it's my first time here. Thanks

 

[schielrn]

Welcome to the Board!

So you want to copy A1:A5 to C1:C5 and then A6:A10 to C6:C10? I don't know what you mean by the next 5 rows, since this would just be copying all of Column A to column C?

 

[paulntee]

Here's a better explanation of what I'm trying to accomplish.
I have Address data that is formatted in groups of 5 rows.
I want to copy that and transpose each address to a single row
I then want to repeat that process for multiple addresses (the groups of 5 rows).
I need to start at the top of the file and repeat until there is no more data.
The number of addresses varies from file to file.
So I need a loop to copy, paste with transpose, then repeat each section until end of file.
Does that make more sense as to what I need to accomplish?
Thanks

 

[schielrn]

So basically you want the data in A1:A5 in A1:E1 and then A6:A10 to go in A2:E2? Is that correct?

 

[paulntee]

yes, that's it.
copy as you said, and continue to end of file.
file can contain anywhere from 100-1000 rows.
thanks for any help

 

[Phanmore]

This code should work. (it's a bit code heavy, I'm just a beginner who's bored at work lol)

Sub test()
Range("A1").Select
Range(ActiveCell, ActiveCell.Offset(4, 0)).Select
Selection.Copy
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A1", "A5").ClearContents
Do Until ActiveCell = ""
Range("A1").Select
Selection.End(xlDown).Select
Range(ActiveCell, ActiveCell.Offset(4, 0)).Select
Selection.Copy
Range("B65536").Select
ActiveCell.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A1").Select
Selection.End(xlDown).Select
Range(ActiveCell, ActiveCell.Offset(4, 0)).Select
Selection.ClearContents
ActiveCell.End(xlDown).Select
Loop

End Sub

 

[schielrn]

This should be a little more efficient and doesn't have all the selecting and wanted to provide something maybe to help Phanmore learn.

Sub transposeData()
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row Step 5
    counter = counter + 1
    Range("A" & i, "A" & i + 4).Copy
    Range("B" & counter).PasteSpecial xlPasteAll, , , True
Next i
Columns(1).Delete
End Sub

This also assumes there isn't really any data in the other columns because it deletes column A after the transpose because you can't copy over your old data. We can modify it if that will be an issue. Hope that helps.

 

[ravishankar]

Hi
try these codes

Sub PaulNtee()
Dim a As Long
For a = 1 To Range("A65536").End(xlUp).Row Step 5
Range("A" & a & ":A" & a + 5).Copy
Range("B" & Round(a / 5 + 1, 0)).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
Next a
MsgBox "complete"
End Sub

ravi

 

[paulntee]

WOW - thanks everyone.
I really appreciate the help.
I'll give these a try tonight and let you know.
This forum has been a good find for me.

 

[wsjackman]

a non code method

in b1 enter
=a2

copy b1 and paste into C1:E1

copy b1:E5
and paste to end of data

copy A1:end of column E
paste special values

select column B

filter for blanks

select from b2 to end of data in column A

delete rows