Contitional copying of cells from one tab to another

[Junkyard Engineer]

20 years + ago, I was once a programmer.But I need to know where to go and
how to start this.

It's for a risk management project. On one tab, I have a list of question
(cell B) and the risk evaluation (cell E) from 1 to 9 (number)

What I want to do is to copy all E cells that are in the 7 to 9 range to a
contingency table on another excel tab in the same workbook. I need to copy
the Code number, the name of the risk and the risk evaluation (that would be
cell A, B and E) sequentially, i.e. no holes in between each task.

The number of question in 1st table is fixed

Once the agent filled out all the risk question, he will press a button and
the macro or VBS will do the rest, filling the contingency table for him.

Can somebody help me start that project ?

 

[Per Erik Midtrød]

Assign the following macro to a button:

Sub CopyHighRisk()
Dim r As Long
Dim i As Long
i = 2
For r = 2 To 10 ' Assuming one header row and nine questions
If Sheet1.Range("e" & r).Value >= 7 Then
Sheet2.Range("a" & i).Value = Sheet1.Range("a" & r).Value
Sheet2.Range("b" & i).Value = Sheet1.Range("b" & r).Value
Sheet2.Range("e" & i).Value = Sheet1.Range("e" & r).Value
i = i + 1
End If
Next
End Sub

Might not be the most sophisticated solution, but at least it is
working.

Per Erik

 

[Junkyard Engineer]

Thanks Per,

I get error 424 trying your code which I modified a bit : (line with an *
which is put only here for clarity)

Sub CopyHighRisk()
Dim r As Long
Dim i As Long
i = 21
For r = i To 113
* If Sheet2.Range("e" & r).Value >= 7 Then
Sheet4.Range("a" & i).Value = Sheet1.Range("A" & r).Value
Sheet4.Range("b" & i).Value = Sheet1.Range("B" & r).Value
i = i + 1
End If
Next
End Sub

While waiting for an answer to my question, I started on my own and got the
following code (which is way longer than yours for the same thing) and get
an error 1004 (line with an * which is put only here for clarity)

Sub PC_Update()
Dim topCel As Range, bottomCel As Range, sourceRange As Range
Dim targetRangePC1 As Range, targetRangePC2 As Range, TopCelPC1 As Range
Dim BottomCelPC1 As Range, TopCelPC2 As Range, BottomCelPC2 As Range
Dim x As Integer, i As Integer, numofRows As Integer

Set topCel = Range("D21")
Set bottomCel = Range("D113").End(xlUp)
If topCel.Row > bottomCel.Row Then End
Set sourceRange = Range(topCel, bottomCel)

Set TopCelPC1 = Sheets("Plan de contingence PC").Range("a21")
Set BottomCelPC1 = Sheets("Plan de Contingence PC").Range("a113")
Set TopCelPC2 = Sheets("Plan de contingence PC").Range("b21")
Set BottomCelPC2 = Sheets("Plan de Contingence PC").Range("b113")
* Set targetRangePC1 = Range(TopCelPC1, BottomCelPC1)
Set targetRangePC2 = Range(TopCelPC2, BottomCelPC2)

numofRows = sourceRange.Rows.Count

x = 1
For i = 1 To numofRows
If sourceRange(i) = "Élevé" Then
targetRangePC1(x) = sourceRange(i).Offset(-3, 0)
targetRangePC2(x) = sourceRange(i).Offset(-2, 0)
x = x + 1
End If
Next
End Sub

Any ideas ?

 

[Junkyard Engineer]

OK, found a working solution

Sub CopyHighRisk()
Dim r As Long
Dim i As Long
i = 15
For r = i To 113
If Sheets("Évaluation Planification EP").Range("d" & r).Value = "Élevé"
Then
Sheets("Plan de contingence PC").Range("a" & i).Value =
Sheets("Évaluation Planification EP").Range("A" & r).Value
Sheets("Plan de contingence PC").Range("b" & i).Value =
Sheets("Évaluation Planification EP").Range("B" & r).Value
i = i + 1
End If
Next
End Sub

Thanks !

 

[Per Erik Midtrød]

Glad I could be of some assistance.

Per Erik

OK, found a working solution

Sub CopyHighRisk()
Dim r As Long
Dim i As Long
i = 15
For r = i To 113
If Sheets("Évaluation Planification EP").Range("d" & r).Value = "Élevé"
Then
Sheets("Plan de contingence PC").Range("a" & i).Value =
Sheets("Évaluation Planification EP").Range("A" & r).Value
Sheets("Plan de contingence PC").Range("b" & i).Value =
Sheets("Évaluation Planification EP").Range("B" & r).Value
i = i + 1
End If
Next
End Sub

Thanks !