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 your Macro works fine except it's ignore only the last row.

Thanks a lot sir.

[baset]

Thanks a lot Mr. SamT for your additions to enhance the macro.

Thanks a lot sir.