Copying every other Cell Word 2003

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Jim - 24 Feb 2005 20:08 GMT

I have been using the macro below to copy the first cell and then copy to
all other cells on the Sheet. However with Labels I actually need to copy to
every other
cell horizontally, and then miss the next row of cells, as they are used
for vertical spacing
and then copy every other cell again, as the gap is needed to space the
label horizontally,
so it becomes tedious to delete the contents of every other Cell. Can this
macro be easily modified?
Jim

Sub TableFillWithThisCell()
' Fills all cells in current table with contents of current cell
Dim objSelObj As Cell

Application.ScreenUpdating = False

On Error Resume Next ' In case insertion point is not within a table or
selected range is not within one cell
Selection.SelectCell
If Err.Number <> 0 Then
Beep
Exit Sub
End If
On Error GoTo 0

Set objSelObj = Selection.Cells(1)

Selection.Copy
Selection.SelectRow
Selection.SelectColumn
Selection.Paste

objSelObj.Select
Selection.Collapse

Application.ScreenUpdating = True

End Sub

Reply to this Message

G.G.Yagoda - 24 Feb 2005 22:03 GMT

Assumes that cursor is within the table and that odd numbered rows will
contain text while even numbered rows will remain blank.

Dim Tbl As Table, Rw As Row, C As Cell
Dim Rng As Range, RwNo As Integer, n As Byte
Set Tbl = Selection.Tables(1)
Set Rng = Tbl.Rows(1).Cells(1).Range
Rng.End = Rng.End - 1
Rng.Copy
For RwNo = 1 To Tbl.Rows.Count Step 2
Set Rw = Tbl.Rows(RwNo)
For Each C In Rw.Cells
C.Range.Text = ""
C.Range.Paste
Next
Next

Reply to this Message

Jim - 25 Feb 2005 13:49 GMT

Hi
Many thanks for your macro which works fine for the rows.
However, the columns only need to paste into alternate cells (ie:
col1,3,5,7etc)
and leave the even ones blank (ie: col2,4,6,8)fill in when having
material pasted into the sheet.
Thanks for your help so far.
Jim

> Assumes that cursor is within the table and that odd numbered rows will
> contain text while even numbered rows will remain blank.
[quoted text clipped - 12 lines]
> Next
> Next

Reply to this Message

G.G.Yagoda - 26 Feb 2005 00:57 GMT

See if this does the trick, Jim:

Dim Tbl As Table, Rw As Row, C As Cell
Dim Rng As Range, RwNo As Integer, n As Byte
Set Tbl = Selection.Tables(1)
Set Rng = Tbl.Rows(1).Cells(1).Range
Rng.End = Rng.End - 1
Rng.Copy
For RwNo = 1 To Tbl.Rows.Count Step 2
Set Rw = Tbl.Rows(RwNo)
For n = 1 To Rw.Cells.Count Step 2
Set C = Rw.Cells(n)
C.Range.Text = ""
C.Range.Paste
Next
Next

Reply to this Message

Jim - 26 Feb 2005 13:32 GMT

Yes, that works well. I notice in error trapping on say using a blank page
I get an error 91 variable not set which refers to object variable not set:
Rng.End = Rng.End - 1
What should I set the variable Rng.End as?
Below is your modified code.
Many thanks for your help
Jim

On Error Resume Next
Dim Tbl As Table, Rw As Row, C As Cell
Dim Rng As Range, RwNo As Integer, n As Byte
Set Tbl = Selection.Tables(1)
Set Rng = Tbl.Rows(1).Cells(1).Range
On Error GoTo 0
Application.ScreenUpdating = False
Rng.End = Rng.End - 1
Rng.Copy
For RwNo = 1 To Tbl.Rows.Count Step 2
Set Rw = Tbl.Rows(RwNo)
For n = 1 To Rw.Cells.Count Step 2
Set C = Rw.Cells(n)
C.Range.Text = ""
C.Range.Paste
Next
Next
Application.ScreenUpdating = True

> See if this does the trick, Jim:
>
[quoted text clipped - 12 lines]
> Next
> Next

Reply to this Message

G.G.Yagoda - 26 Feb 2005 23:59 GMT

Each table cell has an end of cell mark in it as represented by the
little square box. Rng.End = Rng.End - 1 means "don't include the end
of cell mark when you copy the text."

I can't seem to duplicate the error message; as long as I'm in a table
and there's text in the first cell, it works.

Maybe someone else will see the cause of the error and explain it to us
both.

Reply to this Message

Jim - 27 Feb 2005 10:46 GMT

Yes, that is right, where it falls over is if you are on a blank page
and someone who doesn't understand how to get out of a
macro panics!
Only trying to make it idiot proof!!!
Many thanks for your input. Much appreciated.
Jim

> Each table cell has an end of cell mark in it as represented by the
> little square box. Rng.End = Rng.End - 1 means "don't include the end
[quoted text clipped - 5 lines]
> Maybe someone else will see the cause of the error and explain it to us
> both.

Reply to this Message

G.G.Yagoda - 27 Feb 2005 19:14 GMT

Add this at the beginning of the macro. It should prevent user panic:

If Not Selection.Information(wdWithInTable) Then
MsgBox "Cursor must be in a table. Quitting.", , "Not in Table"
Exit Sub
End If

Reply to this Message

Rate this thread: