# Copy range depending on a cell values

[Closed]
Report

isengard678

TrowaD

- Posts
- 1
- Registration date
- Monday November 12, 2012
- Status
- Member
- Last seen
- November 12, 2012

TrowaD

- Posts
- 2819
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- October 25, 2021

Related:

- Copy range depending on a cell values
- Conditional formatting for cells depending on other cells ranges ✓ - Forum - Excel
- Copy and paste loop in vba based on cell values ✓ - Forum - Excel
- How to create multiple workbooks from a list of cell values ✓ - Forum - Excel
- How to copy cell values from one sheet to another - How-To - Excel
- Grey out an entire row in Excel 2010 depending on a cell's value ✓ - Forum - Excel

## 4 replies

TrowaD

- Posts
- 2819
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- October 25, 2021

Hi Isengard,

See if this script is to your liking:

Best regards,

Trowa

See if this script is to your liking:

Sub Test() Dim lRow, x, y As Integer Sheets("Sheet1").Select lRow = Range("A" & Rows.Count).End(xlUp).Row x = 1 Do x = x + 1 y = Range("E" & x).Value Do Range(Cells(x, "A"), Cells(x, "C")).Copy _ Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) y = y - 1 Loop Until y = 0 If Range("F" & x).Value = 1 Then Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ Sheets("Sheet1").Range("A" & x).Value Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ Sheets("Sheet1").Range("B" & x).Value Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ Sheets("Sheet1").Range("D" & x).Value End If Loop Until x = lRow End Sub

Best regards,

Trowa

isengard678

Trowa,

thanx for the quick solution, it works as long as the value in "E" is >0 and not empty!

Any idea how I can solve this last issue?

best regards,

Kris

thanx for the quick solution, it works as long as the value in "E" is >0 and not empty!

Any idea how I can solve this last issue?

best regards,

Kris

TrowaD

- Posts
- 2819
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- October 25, 2021

Here you go Kris:

Best regards,

Trowa

Sub Test() Dim lRow, x, y As Integer Sheets("Sheet1").Select lRow = Range("A" & Rows.Count).End(xlUp).Row x = 1 Do x = x + 1 y = Range("E" & x).ValueIf y = 0 Then GoTo Next_xDo Range(Cells(x, "A"), Cells(x, "C")).Copy _ Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) y = y - 1 Loop Until y = 0 If Range("F" & x).Value = 1 Then Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ Sheets("Sheet1").Range("A" & x).Value Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ Sheets("Sheet1").Range("B" & x).Value Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ Sheets("Sheet1").Range("D" & x).Value End IfNext_x:Loop Until x = lRow End Sub

Best regards,

Trowa

Isengard678

Great, but now i need an extra check , "If y = 0 Then GoTo Next_x" only if the value in column f for that row = 0...

Thanks!!!

Thanks!!!

TrowaD

- Posts
- 2819
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- October 25, 2021

Hi Isengard,

I've honored your request, but what about you comments in your 14 nov post?

Best regards,

Trowa

I've honored your request, but what about you comments in your 14 nov post?

Sub Test() Dim lRow, x, y As Integer Sheets("Sheet1").Select lRow = Range("A" & Rows.Count).End(xlUp).Row x = 1 Do x = x + 1 y = Range("E" & x).Value If y = 0And Range("F" & x).Value = 0Then GoTo Next_x Do Range(Cells(x, "A"), Cells(x, "C")).Copy _ Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) y = y - 1 Loop Until y = 0 If Range("F" & x).Value = 1 Then Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ Sheets("Sheet1").Range("A" & x).Value Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ Sheets("Sheet1").Range("B" & x).Value Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ Sheets("Sheet1").Range("D" & x).Value End If Next_x: Loop Until x = lRow End Sub

Best regards,

Trowa