macro for rearranging data
This code drops the rearranged data onto a seperate sheet. It assumes the
source data is on sheet 1 columns A2:A???. It puts the new data onto sheet
2... You can change those to suite (you just need to change the stuff between
the quotes "Sheet1", "Sheet2", "A2", "A")
Sub MoveStuff()
Dim rngToSearch As Range
Dim rngPaste As Range
Dim rng As Range
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim intCounter As Integer
Set wksCopyFrom = Sheets("Sheet1")
Set wksCopyTo = Sheets("Sheet2")
With wksCopyFrom
Set rngToSearch = .Range(.Range("A2"), .Cells(Rows.Count, "A").End(xlUp))
End With
wksCopyTo.Cells.ClearContents
Set rngPaste = wksCopyTo.Range("A2")
intCounter = 0
For Each rng In rngToSearch
If intCounter = 0 Then
rngPaste.Offset(0, intCounter).Value = rng.Value
Else
rngPaste.Offset(0, intCounter).Value = rng.Offset(0, 1).Value
End If
intCounter = intCounter + 1
If intCounter = 4 Then
intCounter = 0
Set rngPaste = rngPaste.Offset(1, 0)
End If
Next rng
End Sub
--
HTH...
Jim Thomlinson
"LU" wrote:
Hi,
I need some help, please. I have to rearrange data in my worksheet that
looks like this:
A B
WALNUT
NUMBER VISITS 2
CHARGES($000) 2.0
%PAID($) 83.57
LOMPOC
NUMBER VISITS 3
CHARGES($000) 3.3
%PAID($) 31.07
HILMAR
NUMBER VISITS 1
CHARGES($000) 2.1
%PAID($) 18.01
WINTHROP
NUMBER VISITS 1
CHARGES($000) 1.5
%PAID($) 95
into the horizontal view like that.
A B C D
WALNUT 2 2.0 83.57
LOMPOC 3 3.3 31.07
HILMAR 1 2.1 18.01
WINTHROP 1 1.5 95
Ive been using €śCopy and Past Special€ť with Transpose option, and it worked
well, but my worksheet is so huge that it will take forever for me to do so.
I recorded a Macro, but dont know how to tell to start at the beginning and
go across the sheet. Could some one help me, please with a Macro here?
Thanks so much,
Lu.
|