Copying Down and Across
 

Problem,

I have a problem with a spreadsheet that comes down the page in
"steps".(If you had a blank sheet of paper turn it landscape and draw a line
from the bottom left hand corner to the top right hand corner and just look
at the area above the line - that's the shape of the spreadsheet.)

Each month I have to add a new step to those already there. Each step is
4 cols wide and 6 rows down, so for example this month I would highlight
cells A100:D105 and then drag down so the new cells are A106:D111. I now go
to the next step which would be from E94:H99 highlight the cells and
dragdown to E100:H105.......and so on across the page.

Can I automate this process if so how.... cause this is a big spreadsheet.

With thanks

Bob

Copying Down and Across
 

Bob,
this should do it:

Sub FillSheet()
Dim r&, n&
With ActiveSheet
For r = [a65536].End(xlUp).Row To 1 Step -6
.Cells(r, 4 * n + 1).Resize(6 * (n + 1), 4).FillDown
n = n + 1
If Intersect(.Cells(r, 4 * n + 1), .UsedRange) Is Nothing Then
Exit For
End If
Next
End With
End Sub


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Robert Gillard" wrote:

Problem,

I have a problem with a spreadsheet that comes down the page
in
"steps".(If you had a blank sheet of paper turn it landscape and draw
a line from the bottom left hand corner to the top right hand corner
and just look at the area above the line - that's the shape of the
spreadsheet.)

Each month I have to add a new step to those already there. Each
step is
4 cols wide and 6 rows down, so for example this month I would
highlight cells A100:D105 and then drag down so the new cells are
A106:D111. I now go to the next step which would be from E94:H99
highlight the cells and dragdown to E100:H105.......and so on across
the page.

Can I automate this process if so how.... cause this is a big
spreadsheet.

With thanks

Bob

Copying Down and Across
 

Bob

I'm not sure, what you mean by "drag down" (move or copy??),
but this code may get you started:

Sub InsertNewStep()
'Leo Heuser, 16 Sept. 2003
Dim StepBlock As Range

Set StepBlock = Sheets("Ark2"). _
Cells(ActiveSheet.Rows.Count, 1). _
End(xlUp).Offset(-5, 0).Resize(6, 4)

On Error Resume Next

Do
StepBlock.Offset(6, 0).Interior.ColorIndex = 3
Set StepBlock = StepBlock.Offset(-6, 4)
Loop Until Err.Number 0

On Error GoTo 0

End Sub



--
Best Regards
Leo Heuser
MVP Excel

Followup to newsgroup only please.

"Robert Gillard" skrev i en meddelelse
...
Problem,

I have a problem with a spreadsheet that comes down the page in
"steps".(If you had a blank sheet of paper turn it landscape and draw a
line
from the bottom left hand corner to the top right hand corner and just
look
at the area above the line - that's the shape of the spreadsheet.)

Each month I have to add a new step to those already there. Each step
is
4 cols wide and 6 rows down, so for example this month I would highlight
cells A100:D105 and then drag down so the new cells are A106:D111. I now
go
to the next step which would be from E94:H99 highlight the cells and
dragdown to E100:H105.......and so on across the page.

Can I automate this process if so how.... cause this is a big spreadsheet.

With thanks

Bob

Copying Down and Across
 

Excellent ... a really big thank you it was exactly what I wanted.

Bob


"zantor" wrote in message
...
Hi Robert,

I have attached a file called Robert.xls. I have written a procedure
called CopyMyCells1 (You will find it in Module1).

Have a look and see if it is wat you want.

File Attached: http://www.exceltip.com/forum/attach...?postid=262886
(robert.xls)

------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/

Copying Down and Across
 

Zantor,

Test file worked great, but when I try to apply it to actual file
nothing happens. What I omitted to mention in my post was that the actual
spreadsheet did not start until C17, I have tried to "fiddle" with it but
cannot correctly set the start Range.

I apologise for not being precise enough in my initial post, is it
possible that you could again assist me.

with thanks

Bob


Sub CopyMyCells1()
Dim r, c As Integer
r = 1
c = 1

Do Until Cells(r, c) = ""

Do Until Cells(r, c) = ""
r = r + 1
Loop
Cells(r - 6, c).Select
Range(Cells(r - 6, c), Cells(r - 1, c + 3)).Copy
Cells(r, c).Select
ActiveSheet.Paste
Application.CutCopyMode = False
c = c + 4
r = 1
Loop

End Sub

"zantor" wrote in message
...
Hi Robert,

I have attached a file called Robert.xls. I have written a procedure
called CopyMyCells1 (You will find it in Module1).

Have a look and see if it is wat you want.

File Attached: http://www.exceltip.com/forum/attach...?postid=262886
(robert.xls)

------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/

Copying Down and Across
 

Hi Robert,

You need to set r=17 at the beginning of the sub and at the end.

Sub CopyMyCells1()
Dim r, c As Integer
r = 17
c = 1

Do Until Cells(r, c) = ""

Do Until Cells(r, c) = ""
r = r + 1
Loop
Cells(r - 6, c).Select
Range(Cells(r - 6, c), Cells(r - 1, c + 3)).Copy
Cells(r, c).Select
ActiveSheet.Paste
Application.CutCopyMode = False
c = c + 4
r = 17
Loop

End Sub



------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/