EXCEL VBA 1週間のデータを別のシートにコピーする

Question

ブックには2枚あり、1枚はすべてのデータ（ "hdagarb"）、もう1枚は "サマリー"です。データシートでは、列2は名前を持ち、列5は日付を持っています。これらは私が関係しているコラムです。私は6月9日に終了する週の中にあるすべての行を取得し、2列目の名前と5列目の日付をコピーしてサマリーシートに貼り付けます。現時点では、列2の名前をコピー＆ペーストすることさえできません。ここに私のコードは次のとおりです。

Sub finddata() 


Dim todaysdate As Date 
Dim thisweek As Date 
Dim lastweek As Date 
Dim finalrow As Long 
Dim Rdate As Date 
Dim i As Long 

Sheets("Summary").Range("H5:H1000").ClearContents 

todaysdate = Date 
thisweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate 
lastweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate - 7 


finalrow = Sheets("HDAGarb").Range("A100000").End(xlUp).Row 


For i = 2 To finalrow 

Rdate = Sheets("hdagarb").Cells(i, 5) 

If Rdate > lastweek Then 
    Sheets("hdagarb").Cells(i, 2).Copy 
    Sheets("Summary").Range("H100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 
    End If 

Next i 


Worksheets("summary").Activate 
Worksheets("summary").Range("H5").Select 

End Sub 

列5のソースデータは、私はスクリプトが日付なしのエントリを無視するこの

02-Jun-2017 
- 
- 
- 
- 
12-Apr-2017 
01-May-2017 

のようなものです（「 - 」）。

Answer 1

列Eに有効な日付がある場合、次のコードはコピーだけを実行します：

Sub finddata() 
    Dim todaysdate As Date 
    Dim thisweek As Date 
    Dim lastweek As Date 
    Dim finalrow As Long 
    Dim newRow As Long 
    Dim Rdate As Date 
    Dim i As Long 
    Dim srcSheet As Worksheet 
    Dim dstSheet As Worksheet 

    todaysdate = Date 
    thisweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate 
    lastweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate - 7 

    Set srcSheet = Worksheets("HDAGarb") 
    Set dstSheet = Worksheets("Summary") 

    finalrow = srcSheet.Range("A" & srcSheet.Rows.Count).End(xlUp).Row 

    dstSheet.Range("H5:H" & dstSheet.Cells(dstSheet.Rows.Count, "H").End(xlUp).Row).ClearContents 
    newRow = 4 

    For i = 2 To finalrow 
     If IsDate(srcSheet.Cells(i, "E").Value) Then 
      Rdate = CDate(srcSheet.Cells(i, 5).Value) 

      If Rdate > lastweek Then 'or If Rdate > lastweek And Rdate <= thisweek Then '??? 
       newRow = newRow + 1 
       srcSheet.Cells(i, "B").Copy 
       dstSheet.Cells(newRow, "H").PasteSpecial xlPasteFormulasAndNumberFormats 
       'Not sure whether you wanted the next two lines 
       srcSheet.Cells(i, "E").Copy 
       dstSheet.Cells(newRow, "I").PasteSpecial xlPasteFormulasAndNumberFormats 
      End If 
     End If 
    Next i 

    dstSheet.Activate 
    dstSheet.Range("H5").Select 
End Sub 

があれば、私はまた、そのようサマリシートに書き込まれている行を追跡するために、それを変更HDAGarbシートの名前の1つが空白のままであっても、それはそれと関連する日付をコピーします。 （最後の行である再計算を続ける必要がない場合は速くなります）