VBAは、私が検索し、新鮮な目で見て壁に頭を叩いていくつかの時間を費やし細胞

Question

これはここで私の最初の投稿です内の値を認識していないが、私はまだVBAを学んでいますし、何かが欠けていてもよいです。 私は平均値を計算することができますので、私の前のエントリの歴史を持つテーブルに、列Iの入力からそれらを値のグループを移動しようとしています。 私は、入力フィールドの値を検出するために、IF条件を使用していますが、何らかの理由では、IFループの最後までスキップしてくれELSE結果を提供します。 私が間違っていることが目立ちますか？

事前に感謝

Sub MoveValuesToPrior() 
' 
' MoveValuesToPrior Macro 
' 
Application.ScreenUpdating = False 

If WorksheetFunction.Sum(Sheets(2).Range("D3:D1000")) > 0 Then 

Sheets(1).Range("C2:C11").Copy 
Sheets(1).Range("B2").PasteSpecial Paste:=xlPasteValues 

Sheets(2).Range("D3:D1000").Copy 
Sheets(2).Range("C3").PasteSpecial Paste:=xlPasteValues 
Sheets(2).Range("D3:D1000").ClearContents 
Sheets(2).Range("L3:L1000").Copy 
Sheets(2).Range("K3").PasteSpecial Paste:=xlPasteValues 
Sheets(2).Range("L3:L1000").ClearContents 

Sheets(3).Range("D3:D1000").Copy 
Sheets(3).Range("C3").PasteSpecial Paste:=xlPasteValues 
Sheets(3).Range("D3:D1000").ClearContents 
Sheets(3).Range("L3:L1000").Copy 
Sheets(3).Range("K3").PasteSpecial Paste:=xlPasteValues 
Sheets(3).Range("L3:L1000").ClearContents 

Sheets(4).Range("D3:D1000").Copy 
Sheets(4).Range("C3").PasteSpecial Paste:=xlPasteValues 
Sheets(4).Range("D3:D1000").ClearContents 
Sheets(4).Range("L3:L1000").Copy 
Sheets(4).Range("K3").PasteSpecial Paste:=xlPasteValues 
Sheets(4).Range("L3:L1000").ClearContents 

Sheets(5).Range("D3:D1000").Copy 
Sheets(5).Range("C3").PasteSpecial Paste:=xlPasteValues 
Sheets(5).Range("D3:D1000").ClearContents 
Sheets(5).Range("L3:L1000").Copy 
Sheets(5).Range("K3").PasteSpecial Paste:=xlPasteValues 
Sheets(5).Range("L3:L1000").ClearContents 

Sheets(6).Range("D3:D1000").Copy 
Sheets(6).Range("C3").PasteSpecial Paste:=xlPasteValues 
Sheets(6).Range("D3:D1000").ClearContents 
Sheets(6).Range("L3:L1000").Copy 
Sheets(6).Range("K3").PasteSpecial Paste:=xlPasteValues 
Sheets(6).Range("L3:L1000").ClearContents 

Sheets(7).Range("D3:D1000").Copy 
Sheets(7).Range("C3").PasteSpecial Paste:=xlPasteValues 
Sheets(7).Range("D3:D1000").ClearContents 
Sheets(7).Range("L3:L1000").Copy 
Sheets(7).Range("K3").PasteSpecial Paste:=xlPasteValues 
Sheets(7).Range("L3:L1000").ClearContents 

Sheets(8).Range("D3:D1000").Copy 
Sheets(8).Range("C3").PasteSpecial Paste:=xlPasteValues 
Sheets(8).Range("D3:D1000").ClearContents 
Sheets(8).Range("L3:L1000").Copy 
Sheets(8).Range("K3").PasteSpecial Paste:=xlPasteValues 
Sheets(8).Range("L3:L1000").ClearContents 

Sheets(9).Range("D3:D1000").Copy 
Sheets(9).Range("C3").PasteSpecial Paste:=xlPasteValues 
Sheets(9).Range("D3:D1000").ClearContents 
Sheets(9).Range("L3:L1000").Copy 
Sheets(9).Range("K3").PasteSpecial Paste:=xlPasteValues 
Sheets(9).Range("L3:L1000").ClearContents 

Sheets(1).Activate 

Application.CutCopyMode = False 


Else: MsgBox ("The current data has already been moved to prior.") 

End If 


Application.ScreenUpdating = True 

End Sub 

Answer 1

ループとサブルーチンを管理するためにあなたのコードをより簡単に：

Sub MoveValuesToPrior() 

    Dim x As Long 

    Application.ScreenUpdating = False 

    If WorksheetFunction.Sum(Sheets(2).Range("D3:D1000")) > 0 Then 

     'False as last argument -> don't clear source range 
     CopyValues Sheets(1).Range("C2:C11"), Sheets(1).Range("B2"), False 

     For x = 2 To 9 
      CopyValues Sheets(x).Range("D3:D1000"), Sheets(x).Range("C3") 
      CopyValues Sheets(x).Range("L3:L1000"), Sheets(x).Range("K3") 
     Next x 
    Else 
     MsgBox ("The current data has already been moved to prior.") 
    End If 

    Sheets(1).Activate 
    Application.ScreenUpdating = True 

End Sub 

Sub CopyValues(rngFrom As Range, rngTo As Range, Optional clearSource As Boolean = True) 
    With rngFrom 
     rngTo.Resize(.Rows.Count, .Columns.Count).Value = .Value 
     If clearSource Then .ClearContents 
    End With 
End Sub