ループと配列を使用してあるワークシートの特定の値を別のワークシートにマッピングする

Question

特定の条件が満たされている場合、データリストの特定の値を別のワークシートにマップしようとしています。私は過去に配列を使ってこれを行ってきましたが、今はランタイムエラーが発生しており、デバッグできません。マッピングは、この（条件が満たされていると仮定して）ように動作：A、B、列A、B、AKにC、ALのDおよびE.

にAM

Sub newcontracts() 
    Dim source As Variant 
    Dim destination As Variant 
    Dim j As Integer 
    Dim x As Integer 
    Dim LastRow As Long 

    source = Array("A", "B", "AK", "AL", "AM") 
    desitnation = Array("a", "b", "c", "d", "e") 

    LastRow = ThisWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row 
    LastRow3 = ThisWorkbook.Sheets("New Contracts").Cells(Rows.Count, 1).End(xlUp).Row 

    Worksheets("New Contracts").Range("A2:i10").ClearContents 

    With Worksheets(2) 
     For x = 11312 To LastRow 
      If (IsEmpty(Cells(x, 39)) = False Or Cells(x, 39) <> 0) And Cells(x, 40) = "no" Then 
       For j = 0 To 4 
        .Range(source(j) & x).Copy Sheets("New Contracts").Range(destination(j) & Rows.Count).End(xlUp)(1) 
       Next j 
      End If 
     Next x 
    End With 
End Sub 

ありがとう百万！

Answer 1

これは動作していると思われるコードの新しい繰り返しです。 @Peh、私はすべてのシートを指定する必要があるか分からない。私は以前にどのシートを宣言していたのでしょうか？とにかく...ここにコードがある...私はあなたの入力

Sub newcontracts() 

Dim source As Variant 
Dim destination As Variant 
Dim j As Integer 
Dim x As Integer 
Dim LastRow As Long 
Dim LastRow3 As Long 

source = Array("A", "B", "AK", "AL", "AM") 
destination = Array("a", "b", "c", "d", "e") 


LastRow3 = ThisWorkbook.Sheets("New Contracts").Cells(Rows.Count, 1).End(xlUp).Row 

Worksheets("New Contracts").Range("A2:i10").ClearContents 

With Worksheets(2) 

LastRow = .Cells(Rows.Count, 1).End(xlUp).Row 

For x = 25 To LastRow 

If .Rows(x).EntireRow.Hidden = False Then 

If (IsEmpty(.Cells(x, 39)) = False Or .Cells(x, 39) <> 0) And .Cells(x, 40) = "no" Then 
    For j = 0 To 4 
.Range(source(j) & x).Copy Sheets("New Contracts").Range(destination(j) & Rows.Count).End(xlUp)(2) 
Next j 
End If 
End If 
Next x 




End With 

End Sub