VBA Code Assistance

Copper Contributor

Good day community

 

I please require assistance.

Please see my VBA code below

Please see below what the Macro should do:

Step1- Go to the last active Cell in Column A

Step 2 - Move to the corresponding cell in column B

Step 3 - Go the last active cell in column B

Step 4 - Copy the active cell 

Step 5 - Paste the copied detail into column B until the last active cell in column A.

 

The data is dynamic and the positioning of the active cells will change freqeuntly.

 

See a copy of my tried macro below, however it does not provide me with the exact results as I would want it.


1)Range("A1").End(xlDown).Select
2)Code to move to right or left
3)Selection.End(xlUp).Select
4)Selection.Copy
5)Range("B1:B6").Select
6)ActiveSheet.Paste
End Sub

 

Thank you.

 

Jody Barnabas

7 Replies

@jbbarnabas 

 

Maybe I can help you with this food for thought :)

 

Sub active_cell()
Dim AC, AktRange
AC = ActiveSheet.Name
AktRange = ActiveCell.Address
Selection.EntireRow.Copy
Sheets("Sheet B").Select
Cells(1, 1).Activate
ActiveSheet.Paste
Sheets(AC).Select
Range(AktRange).Select
End Sub

'Untested

 

 

 

I would be happy to know if I could help.

 

Nikolino

I know I don't know anything (Socrates)

@jbbarnabas 

 

I'm still not sure I understand what you're trying to do. By "active cell," I assume you mean non-empty cell?

 

One way to refer to other cells relative to a specific cell's location is to use the offset method of the range object.

 

I think you want to find the bottom of Col A, then go up to find the bottom of Col B and if that cell in Col B is empty, go up and copy the last non-empty cell in Col B down to the same row as the bottom of Col A?

 

Sub FillColB()
          
     With Range("A1").End(xlDown).Offset(0, 1)
          If .Value = "" Then
               .End(xlUp).Copy Range(.End(xlUp), .Offset(0, 0))
          End If
     End With
     
End Sub

@jbbarnabas 

 

I hope this helps. Thanks !

 

ThisWorkbook.Sheets("Sheet1").Activate

 

lastrow = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lastrow

Range("A" & i).Select
Selection.Copy

Range("B" & i).Select
ActiveSheet.Paste


Next

@JMB17  thanks for the idea.

I`ll check it out to see if it works.

 

@lifeofgauravthank you , will check it out to see if it works as i intend it to.

 

@NikolinoDEthanks, will check it out to see if it works.

@jbbarnabas 

You may try something like this...

Sub CopyPaste()
Dim lr  As Long

lr = Cells(Rows.Count, "A").End(xlUp).Row

'Copy last non-empty cell in column A
'and paste it in column B
Range("A" & lr).Copy Range("B1:B" & lr)
End Sub