コピー貼り付けループ内のオフセットを正しくコーディングする方法VBA

Question

ループ内のセルにコピーして貼り付けようとしています。元の参照としてセルBP3を使用して、各反復の後に、それはBP3すなわちBP4から次のセルにペーストするように書き込むことを試みる。しかし、私は現在、細胞BP4で繰り返すだけです。

' Copy and Paste of CAPEX 4 forecast dates from VR all DVs 
Dim Updated_Spreadsheet As Workbook 
Dim wb As Workbook: Set wb = Workbooks("study tracker.xlsm") 

Set Updated_Spreadsheet = Workbooks("VR.xlsm") 
Set sht = Updated_Spreadsheet.Sheets("Variance Report") 
Set sht2 = wb.Sheets("Environmental Studies") 

'Loop 
Dim cell As Range, lRow As Long, NextRow As Long, lngDataRows As Long 
For Each cell In sht2.Range("A3", sht2.Range("A" & Rows.Count).End(xlDown)) 
    'specifying cell i want to use as a criteria for the filter 
    'cell = sht2.Range("A3").Value 
    sht.Activate 

    'specifying filter range 
    sht.Range("$A$7:$GV$4694").AutoFilter Field:=1, Criteria1:=cell 

    'specifying the exact cell from the filter which I would like to copy 
    sht.UsedRange.SpecialCells _ 
    (xlCellTypeVisible).Areas(2).Columns(171).Cells(1, 1).Copy 
    wb.Activate 

    'pasting into new location 
    lngDataRows = cell.CurrentRegion.Rows.Count - 1 
    Range("BP3").Offset(lngDataRows + 1, 0).Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Next cell 

Answer 1

ループが実行されるたびに同じセルを何度も繰り返し選択しているため、セル「BP4」しか取得できません。 ループを開始する前に、各ループの反復で値が増加する変数を開始します。

OffsetBy = 1 
'Your "For Each" loop starts here 
'(...) 
'Use this variable in here: 
Range("BP3").Offset(lngDataRows + OffsetBy, 0).Select 
OffsetBy = OffsetBy + 1 
Next cell 

希望します。