i_malc
05-30-2013, 02:33 PM
I'm trying to copy a range of cells [if a cell is grater than 0] to the next blank range of cell in another workbook then repeat for ten times.
I've started my code but know there must be an easier way to loop!
Can anyone help?
Workbooks.Open Filename:="C:\Users\xxx\Documents\excel\Book3.xls"
Workbooks("Book3.xls").Activate
If Sheet1.Range("c3") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c3:g3").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c3:g3").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c4") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c4:g4").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c4:g4").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c5") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c5:g5").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c5:g5").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c6") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c6:g6").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c6:g6").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c7") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c7:g7").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c7:g7").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c6") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c8:g8").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c6:g6").PasteSpecial Paste:=xlPasteValues
Windows("Book3.xls").Activate
ActiveWindow.Close True
Windows("Book2.xls").Activate
End If
End If
End If
End If
End If
End If
I've started my code but know there must be an easier way to loop!
Can anyone help?
Workbooks.Open Filename:="C:\Users\xxx\Documents\excel\Book3.xls"
Workbooks("Book3.xls").Activate
If Sheet1.Range("c3") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c3:g3").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c3:g3").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c4") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c4:g4").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c4:g4").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c5") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c5:g5").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c5:g5").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c6") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c6:g6").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c6:g6").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c7") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c7:g7").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c7:g7").PasteSpecial Paste:=xlPasteValues
If Sheet1.Range("c6") > 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("c8:g8").Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Range("c6:g6").PasteSpecial Paste:=xlPasteValues
Windows("Book3.xls").Activate
ActiveWindow.Close True
Windows("Book2.xls").Activate
End If
End If
End If
End If
End If
End If