Copy / Paste Range of Cells Based on Cell Value

[imagana]

Hi, I need help figuring out a code that will do the following:

I am trying to copy a range of cells from sheet 2 to sheet 1 as many times as the number in cell A1 (in Sheet 2) indicates (the number in A1 will change on its own).

I would like to copy range of cells in sheet 2 starting in from cell B3 through the last cell with data (since the length of the range will vary) and paste it in Sheet 1 in column A in the next available blank cell.

Here is an example:
Sheet 2
A1: 3
B3: Cat
B4: Dog
B5: Banana


I would need Range("B3:B5") copied 3 times.

So Sheet 1 would look like the following:

A
Cat
Dog
Banana
Cat
Dog
Banana
Cat
Dog
Banana

I have this so far but it won’t paste all the cells in the range just the first cell of the range:


Sub CopyBasedOnCellValue()

Dim DataEntry As Worksheet, DataSht As Worksheet
Dim ItemName As range, ItemCount As range
Dim NRow As Long, TargetCell As range

With ThisWorkbook
Set DataEntry = .Sheets("Sheet 2")
Set DataSht = .Sheets("Sheet 1")
End With

With DataEntry
Set ItemName = .range("B3:B20")
Set ItemCount = .range("A1")
End With

With DataSht
NRow = .range("A" & Rows.count).End(xlUp).Row + 1
Set TargetCell = .range("A" & NRow)
TargetCell = ItemName.Value

End With

End Sub


Any help is greatly appreciate it!

Thank you so much!

Idalia

 

[JLGWhiz]

Hi imagana, welcome to MrExcel Forum
This procedure should be copied to your standard code module 1.

Sub cpyMult()
Dim sh1 As Worksheet, sh2 As Worksheet, i As long, lr As Long, rng As Range
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
lr = sh2.Cells(RowsCount, 2).End(xlUp).Row
Set rng = sh2.Range("B3:B" & lr)
 For i = 1 To sh2.Range("A1").Value
  rng.Copy sh1.Cells(Rows.Count, 1).End(xlUp)(2)
 Next
End Sub

The code is based on the narrative and illustration in the OP.

 

[imagana]

Thank You so much JLGWhiz for replying.

I tested the code two ways.. 1) added it to the code i originally posted and 2) on its own, (Please let me know if I did not do this correctly)

But oth times I got the following error:

Run-time error '1004'
Application-defined or object-defined error.

Since Im a little new to VBA, I do not know what this error means or how to fix it.

 

[JLGWhiz]

There is a typo on this line:

lr = sh2.Cells(RowsCount, 2).End(xlUp).Row

Should be

lr = sh2.Cells(Rows.Count, 2).End(xlUp).Row

 

[imagana]

OMG! It works!!

One more thing i forgot to mention I think, the cells copied have formulas and I just want the values to be copied.

Again, Thank you so much! I really really appreciate!!

 

[imagana]

Thank you so much JLGWhiz!!

I found a way to make it work, let me know what you think.

<Code>

Sub CopyMult()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, lr As Long, rng As range
Set sh1 = Sheets("Sensor Label")
Set sh2 = Sheets("AHU T1")
lr = sh2.Cells(Rows.count, 2).End(xlUp).Row
Set rng = sh2.range("B3:B" & lr)
For i = 1 To sh2.range("A1").Value
rng.Copy
sh1.Cells(Rows.count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
Next


<Code>

 

[JLGWhiz]

Looks like you're home free.
Regards, JLG