ループ＆2番目の命令で動作しない場合

Question

私は比較的Excel VBAで新しく、私がやっていることは私たちのERPのローダーです。ですから、私の問題はこれです...私は優れたワークシートを持っています。それを原点と呼ぶことにしましょう。

私がしたいことは、原点範囲内の特定のセル（af18）が基準に該当するかどうかをマクロが確認することです。その場合は、元のシートからダミーシートにA18をコピーします。次に、次の列に "{tab}"を挿入し、AF19（次のセル）が基準に該当する場合は、ダミーの次の空白の列にa19をコピーしてから、再度{tab}を挿入します。

現行のコードは1,2,3...\{tab}

しかし、私はそれはこのようになりたい：1,\{tab},2,\{tab}...

Sub CreateLoaderBeta() 

    Dim origin As Worksheet 
    Dim destination As Worksheet 
    Dim desrow As Long 
    Dim descol As Long 
    Dim descolstart As Long 
    Dim origrow As Long 
    Dim origcol As Long 
    Dim rang As Range 
    Dim C As Range 
    Dim qual As Integer 

    Set origin = Sheets("1") 
    Set destination = Sheets("dummy") 
    desrow = 3 
    descol = 1 
    origrow = 18 
    origcol = 32 
    Set rng = Sheets("1").Range("AF18:af47") 
    total = WorksheetFunction.SUM(Worksheets("1").Range("AF18:AF47")) 
    descolstart = destination.cells(desrow, Columns.Count).End(xlToLeft).column 

    If total > 0 Then 

    'Dim headcol As Integer 
    'headcol = 1 

    'origin.cells(3, headcol).Copy 
    'destination.cells(1, descolstart).PasteSpecial Paste:=xlPasteValues 


    For Each C In rng 
     If C = 14 Then 
       origin.cells(origrow, 1).Copy 
       destination.cells(1, descolstart).PasteSpecial Paste:=xlPasteValues 
       destination.cells(1, descolstart + 1).Value = "\{TAB}" 
       descolstart = descolstart + 1 
       origrow = origrow + 1 
     End If 
    Next C 

    destination.Columns("A:U").insert Shift:=xlToRight 
    Call headers 


    Else 'Donothing 


    End If 

    MsgBox total 

    End Sub** 

Answer 1

destination.cells(1, descolstart).PasteSpecial Paste:=xlPasteValues 
destination.cells(1, descolstart + 1).Value = "\{TAB}" 
descolstart = descolstart + 1 

あなたが書いた"\{TAB}"を次の繰り返しで上書きしています。 descolstartは、各繰り返しで2つの列を消費するため、各繰り返しで2だけインクリメントする必要があります。

descolstart = descolstart + 2 ' <------------ +2, not +1