reformatting data

[Jeff Gilstrap]

I have an excel spreadsheet that has contact data in one
colume as follows:

name1
company1
street1
town, st zip 1
blank line
name2
company2
street2
town, st zip 2
blank line

each line is in a different row. I would like to import it
into an access table but the data is difficult to
manipulate now without manually copying and pasting cells.
Any ideas as to how I can manipulate this data into a more
user friendly format such as:

name1 company1 street1 town1 st1 zip1
name2 company2 street2 town2 st2 zip2

thanks much
Jeff G

 

[Soo Cheon Jheong]

Jeff,

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Option Explicit
Sub TEST()

Dim R As Long
Dim F As String

Range("B:E").Clear

R = Cells(Rows.Count, 1).End(xlUp).Row
F = "=OFFSET(Sheet1!$A$1,ROW()*5-5+COLUMN()-2,0)"

With Range("B1:E" & Int(R / 5 + 0.5))
.Value = F
.Value = .Value
End With
Range("B:E").EntireColumn.AutoFit

End Sub
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -



--
Regards,
Soo Cheon Jheong
_ _
^¢¯^
--

 

[Don Lloyd]

Jeff,

The following code does what you want, I think.
For the example it is based on the source data being in column 2(B),
starting at Row 6 and the destination starting at Row 6, Column 4(D).

Sub ReLocate()
Dim SrceRw, DestRw
SrceRw = 6: DestRw = 6
Do
Range(Cells(SrceRw, 2), Cells(SrceRw + 3, 2)).Copy
Cells(DestRw, 4).PasteSpecial Paste:=xlPasteValues, Transpose:=True
SrceRw = SrceRw + 5: DestRw = DestRw + 1
Loop Until Cells(SrceRw, 2) = ""
End Sub

The loop ends when a blank name cell is encountered.
regards,
Don