simple copy-past

[baset]

Hi All

I need a simple excel macro to do the below:

- check for a cell on column B and if has text ignore it
- Then hide the entire row (which has text on cell of column B)
- moving down to the next cell on column B and check it's empty go left on column A and copy the content of A cell then back to B column and past it
- Don't hide this row (that we just copied text inside)
- move to the next cell on column B

Thanks in advance

[Leith Ross]

Hello baset,

Test this macro with your data.



Sub CopyPaste()


Dim Cell As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim Wks As Worksheet

' // Change the worksheet name in double quotes to match your worksheet's name.
Set Wks = Worksheets("Sheet1")

Set RngBeg = Wks.Range("B1")

' // Find the last row with data in it.
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)

For Each Cell In Wks.Range(RngBeg, RngEnd)
If Cell <> Empty Then
Cell.EntireRow.Hidden = True
Else
Cell.Value = Cell.Offset(0, -1).Value
End If
Next Cell

End Sub

[SamT]

The last Row may have "B" purposely empty, so I would use

' // Find the last row with data in it.
Dim LR As long
LR = Application.WorksheetFunction.Max(Wks.Cells(Rows.Count, "B").End(xlUp).Row, _
Wks.Cells(Rows.Count, "A").End(xlUp).Row
Set RngEnd = Wks.Cells(LR, RngBeg.Column)
If it is possible that both "A" and "B" are empty in the actual last Row
Option Explicit

Function RealLastRow(WsName As String) As Long
Dim LastFormula As Range
Dim LastValue As Range

With Worksheets(WsName)
On Error Resume Next
Set LastFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set LastValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
On Error GoTo 0
End With

If LastFormula Is Nothing And LastValue Is Nothing Then
RealLastRow = 1
Exit Function
End If

RealLastRow = Application.WorksheetFunction.Max(LastFormula.Row, LastValue.Row)
End Function


Sub Test_RealLastRow()
Dim Ws As Worksheet

For Each Ws In Worksheets
MsgBox RealLastRow(Ws.Name)
Next
End Sub

[baset]

Lot of thanks Mr. Leith Ross (http://www.vbaexpress.com/forum/member.php?47139-Leith-Ross) your Macro works fine except it's ignore only the last row.

Thanks a lot sir.

[baset]

Thanks a lot Mr. SamT (http://www.vbaexpress.com/forum/member.php?6494-SamT) for your additions to enhance the macro.

Thanks a lot sir.