Related:
- Selecting the required cells info from the co
- Vba select next empty cell in column - How-To - Excel
- Uneditable selected Columns/Rows/Cells Excel ✓ - Forum - Excel
- Select by lowest cell value & group by column ✓ - Forum - Office Software
- Select non blank cells in excel vba ✓ - Forum - Excel
- Vba select next empty cell ✓ - Forum - Programming
2 replies
venkat1926
- Posts
- 1862
- Registration date
- Sunday June 14, 2009
- Status
- Contributor
- Last seen
- July 30, 2015
your sample data is in this url
https://authentification.site/files/22168388/sashi.xls
there are three macros in the vb editor . the sheet2 is after running the macro "test" all the three macros are to be parked in a module. But you should operate only "test" - the second macro is embedded in this.
the macro "undo" is to undo the results of the macro
you see sheet 2 in the uploaded file AFTER running the macro "test"
if you want to recheck
1.first run "undo"
2. second run macro "test"("test" only)
for completion sake I am giving the macros here itself also
https://authentification.site/files/22168388/sashi.xls
there are three macros in the vb editor . the sheet2 is after running the macro "test" all the three macros are to be parked in a module. But you should operate only "test" - the second macro is embedded in this.
the macro "undo" is to undo the results of the macro
you see sheet 2 in the uploaded file AFTER running the macro "test"
if you want to recheck
1.first run "undo"
2. second run macro "test"("test" only)
for completion sake I am giving the macros here itself also
Sub test()
Worksheets("sheet1").Activate
Set cfind = Cells.Find(what:="SL#", after:=Cells(Rows.Count, "A"))
add = cfind.Address
j = cfind.Row
Do
'msgbox j
Set cfind = Cells.FindNext(cfind)
If cfind.Address = add Then
k = Cells(Rows.Count, "A").End(xlUp).Row
GoTo line1
End If
k = cfind.Row
line1:
'msgbox k
Range(Cells(j, "A"), Cells(k - 1, "B")).Copy
Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=True
If cfind.Address = add Then Exit Do
j = k
Loop
removeheadings
End Sub
Sub removeheadings()
Worksheets("sheet2").Activate
Range("A1").EntireRow.Delete
Do
Set cfind = Cells.Find(what:="SL#", after:=Range("A1"))
'msgbox cfind.Address
If cfind Is Nothing Then Exit Do
If cfind.Address = "$A$1" Then Exit Do
cfind.EntireRow.Delete
Loop
Application.CutCopyMode = False
Range("A1").Select
End Sub
Sub undo()
Worksheets("sheet2").Cells.Clear
End Sub
Subscribe To Our Newsletter!
