Range copy

[kalim]

Hi excel users.

What I need is to copy values from a cell down a range.
I have some sample data below (end result). To explain, F3 (DV cell) will be copied and the value is posted in the cells below, up to the last cell on the left. The same is true for the rest.
With the VBA code – I know it is poorly written with all the selects but I think it helps illustrate what I need and I tried to make it dynamic to adapt to all of the ranges I need it for.
It works as is, but (other than needing it to be written better of course)

1) It pastes over the original top cell which I don’t want it to – I will have a heading there. So F3 will then become the cell that is copied and etc for the rest.
2) And can it be done without having to reproduce it x amount of times. Case statement maybe?
Thanks.

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Calibri,Arial; FONT-SIZE: 11pt" border=1 cellSpacing=0 cellPadding=0><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD></TD><TD>E</TD><TD>F</TD><TD>G</TD><TD>H</TD><TD>I</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD></TD><TD>product 1</TD><TD></TD><TD></TD><TD>product 21</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="TEXT-ALIGN: right">1</TD><TD>product 1</TD><TD></TD><TD style="TEXT-ALIGN: right">1</TD><TD>product 21</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: right">2</TD><TD>product 1</TD><TD></TD><TD style="TEXT-ALIGN: right">2</TD><TD>product 21</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: right">3</TD><TD>product 1</TD><TD></TD><TD style="TEXT-ALIGN: right">3</TD><TD>product 21</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD></TD><TD></TD><TD></TD><TD style="TEXT-ALIGN: right">4</TD><TD>product 21</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD></TD><TD>product 23</TD><TD></TD><TD style="TEXT-ALIGN: right">5</TD><TD>product 21</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: right">1</TD><TD>product 23</TD><TD></TD><TD></TD><TD></TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: right">2</TD><TD>product 23</TD><TD></TD><TD></TD><TD>product 3</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD style="TEXT-ALIGN: right">3</TD><TD>product 23</TD><TD></TD><TD style="TEXT-ALIGN: right">1</TD><TD>product 3</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD style="TEXT-ALIGN: right">4</TD><TD>product 23</TD><TD></TD><TD style="TEXT-ALIGN: right">1</TD><TD>product 3</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">13</TD><TD style="TEXT-ALIGN: right">5</TD><TD>product 23</TD><TD></TD><TD style="TEXT-ALIGN: right">3</TD><TD>product 3</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">14</TD><TD></TD><TD></TD><TD></TD><TD style="TEXT-ALIGN: right">4</TD><TD>product 3</TD></TR></TBODY></TABLE>

Excel tables to the web >> Excel Jeanie HTML 4

Sub copy1()
    Range("F3").Select
    Selection.Copy
    ActiveCell.Offset(1, -1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
End Sub
 
Sub copy2()
    Range("F8").Select
    Selection.Copy
    ActiveCell.Offset(1, -1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
End Sub
 
Sub copy3()
    Range("I3").Select
    Selection.Copy
    ActiveCell.Offset(1, -1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
End Sub
 
Sub copy4()
    Range("I10").Select
    Selection.Copy
    ActiveCell.Offset(1, -1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
End Sub

 

[cgcamal]

Thanks again for the reply.<!--?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /--><o></o>
<o> </o>
I followed you instructions to the letter, but the code stops and gives a compile error: expected array message. Rws is highlighted.<o></o>

Hi Kalim,

I'm not sure if it is a versions issue, but what Excel version are you using?
May you show the sample of your file to see if something else is affecting in some way?

Regards

 

[Peter_SSs]

[COLOR=Navy]Sub[/COLOR] Copy_Products_On_Click()
[COLOR=Green]'César C. 13/May/2011[/COLOR]

Dim [COLOR="Red"][B]Rws as Integer[/B][/COLOR], Cols as Integer, i as Integer, P as Integer, Sh As String

[COLOR=Green]'Setting up Rows and Columns numbers of main product("F2", "F8", "I2", "I10")[/COLOR]
[COLOR="red"][B]Rws = Array(2, 8, 3, 10)[/B][/COLOR]
Cols = Array(6, 6, 9, 9)

César

The reported error with your code is that you have declared 'rws' as an integer but then tried to use it as an array. Same for Cols of course.

 

[cgcamal]

Hi Peter,

Thanks for found my error. I don´t now why I changed that within the message I posted, when the macro I've tested it was different.

Kalim,

Well I'm not sure if it is the correct syntax, but only change this :

Dim Rws as Integer, Cols as Integer, i as Integer, P as Integer, Sh As String

to this:

 Dim Rws(), Cols(),  i as Integer, P as Integer, Sh As String

and the line below is not needed, you can remove it because was a test (is below Case "Rectangle 4"):

x = Cells(Rws(P), Cols(P))

</pre>
hope this time works for you, for me it does.

Regards

 

[cgcamal]

Kalim,

A modified version based on the last one, but supressing the common content and merging them in a sub routine.

Dim Rws(), Cols(), P As Integer, Sh As String
Sub Copy_Products_On_Click()
'César C. 14/May/2011

'Setting Rows and Columns numbers of main product("F2", "F8", "I2", "I10")
Rws = Array(2, 8, 3, 10)
Cols = Array(6, 6, 9, 9)
P = 4
Sh = ActiveSheet.Shapes(Application.Caller).Name

Select Case Sh
    Case "Rectangle 1"
        P = 0: Call Fill_Delete
    Case "Rectangle 2"
        P = 1: Call Fill_Delete
    Case "Rectangle 3"
        P = 2: Call Fill_Delete
    Case "Rectangle 4"
        P = 3: Call Fill_Delete
    Case "Try again"
        Call Fill_Delete
End Select
End Sub

Sub Fill_Delete()
Dim i As Integer

Select Case P
    Case 0, 1, 2, 3
        Count = Cells(Rws(P) + 1, Cols(P) - 1).End(xlDown).Row - Rws(P) + 1
                Cells(Rws(P), Cols(P)).Resize(Count, 1) = Cells(Rws(P), Cols(P))
    Case Else
       For i = 0 To 3
            Count = Cells(Rws(i) + 1, Cols(i) - 1).End(xlDown).Row - Rws(i)
            Cells(Rws(i) + 1, Cols(i)).Resize(Count, 1).ClearContents
        Next
End Select
End Sub

Regards

 

[kalim]

Thanks for the replyies Peter_SSs and César.

Thanks to you both the code now work well.