Number of rows based on the cell value (loop with copy)

Question

I would like to sync my address list with the number shown in the cell at the front sheet. The situation looks as follows:

In the cell D41 I have the number of flats. Now, when I open the "Address list" sheet I want to have the first row instantly copied 40 times down (marked with red). I know, that it can be described as a loop, this is why I tried this code:

Original source here:

Relocation of multiple images with ID changing

 Private Sub AddressList()
 Dim i As Long
 Dim rg As Range, rg2 As Range

 Dim ws1 As Worksheet, ws2 As Worksheet

 Set ws1 = ThisWorkbook.Sheets("Frontsheet")
 Set ws2 = ThisWorkbook.Sheets("Address list")

 Set rg = ws1.Range("D15").Value


 For i = 1 To rg
 Set rg2 = ws2.Range("B2:R2")
 With rg2.Offset(i - 1, 0)
    .Top = .Top
    .Left = .Left

 End With

 Next I

 End Sub

Here I am getting an error 424: Object required

Another code, which I tried is:

 Sub AddressList()
  Dim i As Long
  Dim LastrowE As Long
  Dim rng As Range
  Dim rg As Range, rg2 As Range

  Dim ws1 As Worksheet, ws2 As Worksheet

  Set ws1 = ThisWorkbook.Sheets("Frontsheet")
  Set ws2 = ThisWorkbook.Sheets("Fibre drop release sheet")

  Set rg = ws1.Range("D32")
  Set rg2 = ws2.Range("A2:k2")

  For i = 1 To rg

  With rg2.offset(i - 1, 0)
     rg2.Copy _
       Destination:=ws2.Range("A3")
  End With

  Next I

  End Sub

it works, but the row is copied only once. I want to have it copied 41 times as states in the Frontshet.D15 cell. How can I do this?

In your last code: `LastrowE As Integer` and `Rng As Range` is missing a `Dim` statement in the beginning. Also it must be `Long` not `Integer`. So: `Dim LastrowE As Long` and `DimRng As Range` also please `Dim i As Long` • I recommend always to activate `Option Explicit`: In the VBA editor go to *Tools* › *Options* › *[Require Variable Declaration](https://www.excel-easy.com/vba/examples/option-explicit.html)*. — Pᴇʜ, May 12 '20 at 15:30
The problem is definitely in .top = .top. When I removed these values from inside of the With statement, then error was gone, although code didn't work too. I put all the pieces of the code in the text, but it is still the same. — Geographos, May 12 '20 at 15:48
I have updated my query, put the screenshot from the last situation. I am not kidding, an error still remains. I wouldn't mess around If there is no issues. It looks like some smallish thing is missing, maybe something in the references? — Geographos, May 12 '20 at 15:53
So what do you expect `.Top = .Top` to do? You cannot change the `top` of a cell/range. Please check the documentation of the [Range.Top property](https://learn.microsoft.com/en-us/office/vba/api/excel.range.top) this property is read-only. Same for `.Left`. — Pᴇʜ, May 12 '20 at 15:58
How about this code, which i uploaded? It copies my value only once instead of cellD15 times. — Geographos, May 12 '20 at 16:20
@AndrasDorko That's not true the variable *is* used later on `For i = 1 To rg`. And actually the question has been solved already. — Pᴇʜ, May 14 '20 at 06:09

Pᴇʜ · Accepted Answer · 2020-05-13T08:45:38.780

6

Because your destination to paste is always A3: Destination:=ws2.Range("A3") it always pastes in A3 (cell D15 times).

The following will copy range A2:K2 and paste it into A3 and the following D15 cells.

Set rg = ws1.Range("D15")
Set rg2 = ws2.Range("A2:K2")

rg2.Copy Destination:=ws2.Range("A3").Resize(RowSize:=rg.Value)

edited May 13 '20 at 08:45

answered May 12 '20 at 17:20

Pᴇʜ

56,719
10
49
73

score 3 · Answer 2 · answered May 12 '20 at 14:55

3

According to Pᴇʜ your issue is when you Set your range rg.

Please copy paste and try this, It must Work :

Private Sub AddressList()
 Dim i As Long
 Dim rg As Range, rg2 As Range

 Dim ws1 As Worksheet, ws2 As Worksheet

 Set ws1 = ThisWorkbook.Sheets("Feuil1")
 Set ws2 = ThisWorkbook.Sheets("Feuil2")

 Set rg = ws1.Range("D15")


 For i = 1 To rg
 Set rg2 = ws2.Range("B2:R2")
 With rg2.Offset(i - 1, 0)
    .Top = .Top
    .Left = .Left

 End With

 Next i

 End Sub

Also Note that for your second try you are using rg1.areas and rg1 does not exist because you didn't set it ..

answered May 12 '20 at 14:55

TourEiffel

4,034
2
16
45

No, It's still the same: Run-time-error 424: Object required. What is the most interesting, if I put the empty cell range in ws1, the code is not executed at all. The error comes up with cells containing any value. – Geographos May 12 '20 at 15:05
@MariuszKrukar Please, if you tell you get an error it is absolutely necessary to tell in which line of the code. Otherwise it is like you have 5 cars and you tell us "the car has an error" we don't know which one. – Pᴇʜ May 12 '20 at 15:18
@Pᴇʜ The error disappear when I modify his Set thats quite strange .. – TourEiffel May 12 '20 at 15:19
@Dorian what did you modify? Sorry I still don't know where the error actually appeared. – Pᴇʜ May 12 '20 at 15:23
@Pᴇʜ Set rg = ws1.Range("D15").value proc the error he told us but deleting the `.value` solve it.. So now **for me** there is no more error. – TourEiffel May 12 '20 at 15:26
1

@Dorian Yes, of course. Your code looks fine, I don't see how the OP could get a *Run-time-error 424: Object required.* error in the code you posted. That is why I asked for where exactly he gets the error. Actually there is no line that can throw this error. So he must have done something else wrong. – Pᴇʜ May 12 '20 at 15:27
ok it looks like i found the line. The debugger points: .Top = .Top – Geographos May 12 '20 at 15:33
The code has been changed. This is better because I can at least copy the value once. What I need is copying this value multiple times which depends on the cell value in frontsheet. – Geographos May 12 '20 at 16:39

score 3 · Answer 3 · answered May 12 '20 at 19:46

try this:

  Dim rg As Range, rg2 As Range
  Dim ws1 As Worksheet, ws2 As Worksheet

  Set ws1 = ThisWorkbook.Sheets("Frontsheet")
  Set ws2 = ThisWorkbook.Sheets("Fibre drop release sheet")

  Set rg = ws1.Range("D32")
  Set rg2 = ws2.Range("A2:k2")  'Check the correct columns

    ws2.Range("A2:K" & rg.Value + 1).Value = rg2.Value    'check the correct columns


  End Sub

Dy.Lee · Answer 4 · 2020-05-13T00:15:35.013

0

Try,

Sub test()
    Dim i As Long, j As Integer, c As Integer
    Dim LastrowE As Long
    Dim rng As Range
    Dim rg As Range, rg2 As Range
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim vResult() As Variant, vDB As Variant

    Set ws1 = ThisWorkbook.Sheets("Frontsheet")
    Set ws2 = ThisWorkbook.Sheets("Fibre drop release sheet") '<~~ Check the sheet name.

    Set rg = ws1.Range("D15") '<~~ Check the cell address.
    'Set rg2 = ws2.Range("A2:k2")
    vDB = ws2.Range("A2:k2")
    c = UBound(vDB, 2)

    ReDim vResult(1 To rg, 1 To c)
    For i = 1 To rg
        For j = 1 To c
            vResult(i, j) = vDB(1, j)
        Next j
    Next i
    ws2.Range("a3").Resize(rg, c) = vResult
End Sub

edited May 13 '20 at 00:15

answered May 12 '20 at 23:45

Dy.Lee

7,527
1
12
14

ReDim vResult(1 To rg, 1 To c) - subscript out of range. – Geographos May 13 '20 at 08:35
@MariuszKrukar, `Set rg = ws1.Range("D15")` , Check if cell d15 has a value – Dy.Lee May 14 '20 at 00:05

José Henrique Melman · Answer 5 · 2020-05-14T21:12:17.640

Occasionally I was creating a "adaptable" Price Table financing exercise, where I could choose the number of instalments to repay a loan.

I adapted to your case, and I assume you are calling this function from the Activate worksheet event on "Address list" sheet. (or you could do it by pressing "Alt+F11" on that sheet open and selecting accordingly from the menu and using this code:

Private Sub Worksheet_Activate()

    lines_to_fill = Worksheets(1).Range("d15").Value
    ' this is to get values from the first sheet, instead of (1) above,
    ' it could be ("Frontsheet")

    Set firstline = Range("B2:R2")
    ' or it could be a named range, too

    ' Not sure if the number can be decreased, so deleting previous contents,
    ' just remove if not applicable.
    Range(firstline.Offset(1, 0), firstline.End(xlDown)).Delete

    ' As it is a mere repetition of the first line, why copying when you could fill?
    Range(firstline, firstline.Offset(lines_to_fill - 1, 0)).FillDown

    ' or, if you really need to iterate for some reason, comment last line
    ' and uncomment the following:
'    For i = 1 To lines_to_fill - 1
'        firstline.Copy Destination:=firstline.Offset(i, 0)
'    Next i



End Sub

Maybe there are better coding practices, etc, but it seems to work pretty well to solve the proposed task.

Why fill if you can copy? There is no benefit in using `FillDown` as far as I can see. — Pᴇʜ, May 15 '20 at 06:10
Yes, you are right, I thought of two things and wrote just one, I meant going iteratively, line-by-line vs just marking a single operation for accomplishing the same thing. That being said, for 40 lines or so, the difference in performance would probably be negligible. — José Henrique Melman, May 15 '20 at 18:04

score -1 · Answer 6 · answered May 13 '20 at 10:10

-1

All you need to do is change

Set rg = ws1.Range("D15").Value

to

Set rg = ws1.Range("D15")

and then yopu can use rg.Value in the for loop

For i = 1 To rg.Value

answered May 13 '20 at 10:10

amitklein

1,302
6
23

1

No, that was not the issue. Check [my answer](https://stackoverflow.com/a/61757961/3219613) and comments below the question to see what the issue was. This question was already solved. – Pᴇʜ May 13 '20 at 10:11
I gave him the solution to the **error 424: Object required** he had in the first code he wrote. – amitklein May 13 '20 at 10:31

Number of rows based on the cell value (loop with copy)

6 Answers6

Linked