Macro to copy from active cell and down

[koperstexdq_dont_use]

Hi,

Can someone help with a macro doing this:

From active cell copy down in actual column until no more cells with text is
met.
Blank cells should be ignored.

That means copying should stop at the end of a cell with text no matter how
many blank cells is in between.

Regards,
Kaj Pedersen

 

[Claus Busch]

Hi Kaj,

Am Sun, 3 Nov 2013 10:52:30 GMT schrieb (e-mail address removed):

From active cell copy down in actual column until no more cells with text is
met.
Blank cells should be ignored.

with not adjacent cells you can't autofill with changing referencies.
But if you want to fill with the same value you can try (text with
blanks is in column A and you want to fill column B from activecell
down):

Sub Test()
Dim LRow As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(ActiveCell.Row, 1), Cells(LRow, 1)) _
.SpecialCells(xlCellTypeConstants).Offset(, 1) _
= ActiveCell
End Sub


Regards
Claus B.

 

[-]

Dim LRow As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(ActiveCell.Row, 1), Cells(LRow, 1)) _
.SpecialCells(xlCellTypeConstants).Offset(, 1) _
= ActiveCell

--------------------------------------------------------------------------------
Hi Claus,

I don't want to fill. Just send the selection (found by the macro) to the
clipboard.
I have tried to google a solution for this, unfortunately without luck.
Do you have another suggestion?

Regards,
Kaj Pedersen

 

[Claus Busch]

Hi Kaj,

Am Sun, 3 Nov 2013 11:59:34 GMT schrieb (e-mail address removed):

I don't want to fill. Just send the selection (found by the macro) to the
clipboard.
I have tried to google a solution for this, unfortunately without luck.

your text with blank cells in column A. Then select a cell in column A
and run the macro (insert the destination for pasting):

Sub Test()
Dim LRow As Long

With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(ActiveCell.Row, 1), .Cells(LRow, 1)) _
.SpecialCells(xlCellTypeConstants, 23).Copy
End With
End Sub

If your text with blank cells in A and you want to copy data in column B
then select a cell in A and run the macro:

Sub Test()
Dim LRow As Long

With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(ActiveCell.Row, 1), .Cells(LRow, 1)) _
.SpecialCells(xlCellTypeConstants, 23).Offset(, 1).Copy
End With
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi Kaj,

Am Sun, 3 Nov 2013 13:11:34 +0100 schrieb Claus Busch:

.SpecialCells(xlCellTypeConstants, 23).Copy

if you have formulas in the column change the line above to:
SpecialCells(xlCellTypeFormulas, 23).copy


Regards
Claus B.

 

[koperstexdq_dont_use]

Hi Claus,

It is almost as I wanted.
I also want to copy the blank cells, so I figured this out myself:

Sub Test()
Dim LRow As Long

With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(ActiveCell.Row, 1), .Cells(LRow, 1)).COPY
End With
End Sub

It works provided I select a cell in column A.
If it is for use in column C, I have to first change the macro. (Digits 1 to
digits 3 in the two lines of the macro).

Is it possible to write a macro so that no matter what cell and column is
selected, the previously specified area will be sent to the clipboard?

Regards,
Kaj Pedersen

 

[Claus Busch]

Hi Kaj,

Am Sun, 3 Nov 2013 12:53:54 GMT schrieb (e-mail address removed):

It works provided I select a cell in column A.
If it is for use in column C, I have to first change the macro. (Digits 1 to
digits 3 in the two lines of the macro).

try:

Sub Test()
Dim LRow As Long

With ActiveCell
LRow = Cells(Rows.Count, .Column).End(xlUp).Row
Range(Cells(.Row, .Column), Cells(LRow, .Column)).Copy
End With
End Sub


Regards
Claus B.

 

[koperstexdq_dont_use]

Perfect. Exactly what I wanted.
Sometimes it is difficult from the beginning to describe the requirement

Thank you for helping once again.

Regards,
Kaj Pedersen

 

[Claus Busch]

Hi Kaj,

Am Sun, 3 Nov 2013 13:27:21 GMT schrieb (e-mail address removed):

Perfect. Exactly what I wanted.
Sometimes it is difficult from the beginning to describe the requirement

always glad to help. Thank you for the feedback.


Regards
Claus B.