VBA搜索值后定义范围

Question

我有一张包含B列中的星期编号的工作表。我试图创建一个宏，它查找单元格J2中的星期编号（或使用输入框）​​，然后找到B列中的星期数选择列CG中的数据并将它们复制到表2中（我可以进行复制等，它定义了我正在努力的范围）。Image of datasheet

这里是代码，显示哪些信息I需要复制和粘贴。我努力使它找到星期编号，然后定义范围。下面的代码少了点本周四

Sub Copy4() 
' 
' Copy Macro 
' Week number 
    Sheets("Sheet1").Range("B14:B17").Copy 
    Sheets("Sheet2").Range("C3").PasteSpecial Paste:=xlPasteValues 
    Sheets("Sheet2").Range("D3").PasteSpecial Paste:=xlPasteValues 
' Data Copy 
    Sheets("Sheet1").Range("C14:G17").Copy 
    Sheets("Sheet2").Range("C4").PasteSpecial Paste:=xlPasteValues 
    Range("B2:G7").Select 
    Application.CutCopyMode = False 
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 
End Sub 

预先感谢任何帮助

Answer 1

Sub copy() 
Dim CopySheet As Worksheet 
Dim PasteSheet As Worksheet 
Set CopySheet = Worksheets("Sheet2") 
Set PasteSheet = Worksheets("Sheet3") 

Dim tableMaxCol As Integer 
Dim tableMaxRow As Integer 

Dim weekNumber As Integer 

Dim row As Integer 

tableMaxCol = CopySheet.Cells(1, CopySheet.Columns.Count).End(xlToLeft).Column 
tableMaxRow = CopySheet.Cells(CopySheet.Rows.Count, 1).End(xlUp).row 

weekNumber = CopySheet.Cells(2, 10).Value 

For row = 2 To tableMaxRow step 4 
    If CopySheet.Cells(row, 2).Value = weekNumber Then 
     CopySheet.Range(CopySheet.Cells(row, 3), CopySheet.Cells(row + 3, 7)).copy _ 
      Destination:=PasteSheet.Range("C4") 
    End If 
Next row 
End Sub 

答案编辑。