从具有许多语句的另一张工作表有条件地复制不起作用

Question

I wanted to save tons of time with a script, so I googled some ways to copy some cells from Excel sheet to another if the statement is true (and in the full code there are ~200 statements), but unfortunately I got stuck, and it just doesn't want to work. The first one runs just fine, but the others, where it should check if the statement is true in another cell on the right, won't work.

Sub Proc1()
Dim value As String, result As String

Value1 = Worksheets("munka4").Range("H6").value
Value2 = Worksheets("munka4").Range("I6").value
Value3 = Worksheets("munka4").Range("J6").value

If Value1 = "Car" Then
 Worksheets("munka4").Range("E6").Copy Worksheets("munka2").Range("F10") 
 Worksheets("munka4").Range("F6").Copy Worksheets("munka2").Range("H10") 
 Worksheets("munka4").Range("D6").Copy Worksheets("munka2").Range("B10") 
 Worksheets("munka4").Range("H9").Copy Worksheets("munka2").Range("B8") 
 Worksheets("munka4").Range("H8").Copy Worksheets("munka2").Range("B12") 
 Worksheets("munka4").Range("H10").Copy Worksheets("munka2").Range("B14") 

 If Value2 = "Car" Then
 Worksheets("munka4").Range("E6").Copy Worksheets("munka2").Range("F10") 
 Worksheets("munka4").Range("F6").Copy Worksheets("munka2").Range("H10") 
 Worksheets("munka4").Range("D6").Copy Worksheets("munka2").Range("B10") 
 Worksheets("munka4").Range("I9").Copy Worksheets("munka2").Range("B8") 
 Worksheets("munka4").Range("I8").Copy Worksheets("munka2").Range("B12")  
 Worksheets("munka4").Range("I10").Copy Worksheets("munka2").Range("B14")  

 If Value3 = "Car" Then
 Worksheets("munka4").Range("E6").Copy Worksheets("munka2").Range("F10") 
 Worksheets("munka4").Range("F6").Copy Worksheets("munka2").Range("H10") 
 Worksheets("munka4").Range("D6").Copy Worksheets("munka2").Range("B10") 
 Worksheets("munka4").Range("J9").Copy Worksheets("munka2").Range("B8") 
 Worksheets("munka4").Range("J8").Copy Worksheets("munka2").Range("B12")  
 Worksheets("munka4").Range("J10").Copy Worksheets("munka2").Range("B14")

 End if 
 End if 
 End if

 End Sub

Answer 1

Since your tests are fully independent, you should close the "if Value" code block after the block of instructions to copy the cells end. Try like this:

Sub Proc1()
Dim value As String, result As String

  Value1 = Worksheets("munka4").Range("H6").value
  Value2 = Worksheets("munka4").Range("I6").value
  Value3 = Worksheets("munka4").Range("J6").value

    If Value1 = "Car" Then
     Worksheets("munka4").Range("E6").Copy Worksheets("munka2").Range("F10") 
     Worksheets("munka4").Range("F6").Copy Worksheets("munka2").Range("H10") 
     Worksheets("munka4").Range("D6").Copy Worksheets("munka2").Range("B10") 
     Worksheets("munka4").Range("H9").Copy Worksheets("munka2").Range("B8") 
     Worksheets("munka4").Range("H8").Copy Worksheets("munka2").Range("B12") 
     Worksheets("munka4").Range("H10").Copy Worksheets("munka2").Range("B14") 
   End if 

     If Value2 = "Car" Then
     Worksheets("munka4").Range("E6").Copy Worksheets("munka2").Range("F10") 
     Worksheets("munka4").Range("F6").Copy Worksheets("munka2").Range("H10") 
     Worksheets("munka4").Range("D6").Copy Worksheets("munka2").Range("B10") 
     Worksheets("munka4").Range("I9").Copy Worksheets("munka2").Range("B8") 
     Worksheets("munka4").Range("I8").Copy Worksheets("munka2").Range("B12")  
     Worksheets("munka4").Range("I10").Copy Worksheets("munka2").Range("B14")  
    End if 

     If Value3 = "Car" Then
     Worksheets("munka4").Range("E6").Copy Worksheets("munka2").Range("F10") 
     Worksheets("munka4").Range("F6").Copy Worksheets("munka2").Range("H10") 
     Worksheets("munka4").Range("D6").Copy Worksheets("munka2").Range("B10") 
     Worksheets("munka4").Range("J9").Copy Worksheets("munka2").Range("B8") 
     Worksheets("munka4").Range("J8").Copy Worksheets("munka2").Range("B12")  
     Worksheets("munka4").Range("J10").Copy Worksheets("munka2").Range("B14")
   End if

End Sub

Answer 2

You've already got an acceptable answer/solution, but regarding this:

(and in the full code there are ~200 statements)

If that means you're going to copy-paste the If statement ~200 times and amend each instance slightly (not sure?), then something like the below could be of use (no copy-pasting should be required).

Option Explicit

Sub CopyCellsFromFirstCarColumn()
    Dim rangeToCheck As Range
    Set rangeToCheck = Worksheets("munka4").Range("H6").Resize(1, 200) ' Assumes 200 checks, and that range is contiguous

    Dim matchResult As Variant
    matchResult = Application.Match("Car", rangeToCheck, 0)

    If IsError(matchResult) Then
        MsgBox ("None of the cells in range '" & rangeToCheck.Address & "' on the sheet '" & rangeToCheck.Parent.Name & "' are 'Car'. Nothing has been copied. Code will stop running now.")
        Exit Sub
    End If

    Dim columnToCopy As Long
    columnToCopy = rangeToCheck.Offset(0, matchResult - 1).Column ' -1 as going from 1-based to 0-based

    ' These cells being copied do not change.
    Worksheets("munka4").Range("E6").Copy Worksheets("munka2").Range("F10")
    Worksheets("munka4").Range("F6").Copy Worksheets("munka2").Range("H10")
    Worksheets("munka4").Range("D6").Copy Worksheets("munka2").Range("B10")

    ' These cells being copied depend on where "Car" was found.
    Worksheets("munka4").Cells(9, columnToCopy).Copy Worksheets("munka2").Range("B8")
    Worksheets("munka4").Cells(8, columnToCopy).Copy Worksheets("munka2").Range("B12")
    Worksheets("munka4").Cells(10, columnToCopy).Copy Worksheets("munka2").Range("B14")

 End Sub

The above will only copy for the first instance of "Car" . I think this is fine in your case, as you said: "I know that there would be only one case, but I don't know in which cell."