HOW CAN I COPY COLUMN TO ROWS
Closed
buds
-
Sep 20, 2009 at 08:06 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Sep 20, 2009 at 10:45 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Sep 20, 2009 at 10:45 PM
Related:
- HOW CAN I COPY COLUMN TO ROWS
- How to delete rows and columns in word - Guide
- Tweetdeck remove column - Guide
- Excel copy column from one sheet to another automatically - Guide
- Excel count occurrences of string in column - Guide
- Excel vba find last non empty cell in column - Guide
1 response
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Sep 20, 2009 at 10:45 PM
Sep 20, 2009 at 10:45 PM
It is not clear what you want
suppose you are having data like this from A1 to B6 in sheet 1
geocode house no.
2 lot 1
2 lot 2
2 lot 3
3 lot 4
3 lot 5
you want in sheet 2 something like this
geocode
2 lot 1 lot 2 lot 3
3 lot 4 lot 5
If this assumption is correct then use this macro (along with the function) . the result will be in sheet 2.
The findall function is taken from Pearson.
suppose you are having data like this from A1 to B6 in sheet 1
geocode house no.
2 lot 1
2 lot 2
2 lot 3
3 lot 4
3 lot 5
you want in sheet 2 something like this
geocode
2 lot 1 lot 2 lot 3
3 lot 4 lot 5
If this assumption is correct then use this macro (along with the function) . the result will be in sheet 2.
The findall function is taken from Pearson.
Sub test()
Dim rng As Range, rng1 As Range, x, c1 As Range, m As Integer
Dim foundrange As Range, resultrange As Range
m = 0
Worksheets("sheet2").Cells.Clear
With Worksheets("sheet1")
Set rng = Range(.Range("A1"), .Range("A1").End(xlDown))
rng.AdvancedFilter action:=xlFilterCopy, copytorange:=Worksheets("sheet2").Range("a1"), unique:=True
Do
x = Worksheets("sheet2").Range("a2").Offset(m, 0)
If x = "" Then Exit Do
Set foundrange = findall(rng, x)
If foundrange Is Nothing Then Exit Do
foundrange.Offset(0, 1).Copy
Worksheets("sheet2").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=True
m = m + 1
Loop
End With
End Sub
Function findall(source As Range, findwhat) As Range
Dim foundcell As Range
Dim firstfound As Range
Dim lastcell As Range
Dim resultrange As Range
With source
Set lastcell = .Cells(.Cells.Count)
End With
On Error Resume Next
On Error GoTo 0
Set foundcell = source.Cells.Find(what:=findwhat, LookAt:=xlWhole)
If Not foundcell Is Nothing Then
Set firstfound = foundcell
Set resultrange = foundcell
End If
Do
Set foundcell = source.Cells.FindNext(after:=foundcell)
If foundcell Is Nothing Then Exit Do
If foundcell.Address = firstfound.Address Then Exit Do
Set resultrange = Application.Union(resultrange, foundcell)
Loop
Set findall = resultrange
End Function
