复制范围由input框指示

我正在寻找一种模式，可以复制Excel表格中的特定范围到新的表格。 目前我有五列。 第一列是一年。 我想指出，例如一个inputinputbox应该复制哪一年。 在B栏中，显示了一年中的几周。 在列C到E，logging特定的数据。 结果，我的工作表看起来像这样：

 Col A Col B Col C Col D ColE Year Week Amount time forecast 2000 1 368 2000w1 400 2000 2 8646 2000w2 8500 until... 2014 52 46546 2014w52 47000 

在input框中，我想指出2014年应该复制到下一张表格。 直到现在我写/编译了下面这个macros：

 Sub Copy_year() Dim Forecastyear As String Dim Rng As Range Forecastyear = InputBox("Enter a year to forecast") If Trim(Forecastyear) <> "" Then With Sheets(2).Range("A:A") Set Rng = .Find(What:=Forecastyear, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then Application.Goto Rng, True Else MsgBox "Nothing found" End If End With End If 'Range(ActiveCell, RC[52,4]).Select End Sub 

这将select包含年份值的第一个单元格。 我想为所选单元格和接下来的51周（一起52周）select满5列。 我怎样才能select所有的数据？

Answer 1

用这个

 Sub Copy_year() Dim Forecastyear As String Dim Rng As Range Forecastyear = InputBox("Enter a year to forecast") If Trim(Forecastyear) <> "" Then With Sheets(2) For Each cell In .Range("A:A") If cell.Value = Forecastyear Then'find first occurrence of year Set Rng = cell Exit For End If Next .Range(Rng.Address).Resize(52, 5).Select'resize for 52 rows and 5 columns End With End If End Sub 

你现在要做什么？ 只是select在cpu时间方面效率相当低