指定された値を持つすべての行を列に貼り付けて貼り付けます

Question

Excelデータベースにマスターワークシートを作成しようとしました。これはセルに参照番号を入力し、マクロを実行してすべてのインスタンスをリストします参照番号の

たとえば、セルE8に参照番号0001を入力した場合、隣接するワークシートに0001があるすべてのインスタンスを見つけて、範囲内のすべての行をコピーして貼り付けるコマンドボタンをクリックできます。

これは私が現時点で持っているコードですが、コピーと貼り付けはありません。 B35：B100の内容をクリアし、最後にセルE8を選択しますが、その間に何も起こらないように見えます。

コピーと貼り付けがうまくいかない理由はありますか？

Option Explicit 
Sub ReturnActions() 

Dim itemnumber As String 
Dim finalrow As Integer 
Dim i As Integer 

Sheet1.Range("B35:N100").ClearContents 

itemnumber = Sheet1.Range("E8").Value 'master worksheet 
finalrow = Sheet3.Range("G10").End(xlUp).Row 'database of information 

For i = 2 To finalrow 
    If Cells(i, 1) = itemnumber Then 
     Sheet3.Range(Cells(i, 2), Cells(i, 12)).Copy 'database worksheet 
     Sheet1.Range("B50").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 'master worksheet 
     End If 
Next i 

Range("E8").Select 'master wowrksheet 

End Sub 

Answer 1

私はどこに間違っていたのか分かりました。私は2つのシートの間でアクティブにするのを忘れた。ある作品の再フォーマットコード：

Option Explicit 
Sub ReturnActions() 

Dim itemnumber As String 
Dim finalrow As Integer 
Dim i As Integer 

Sheet1.Range("B35:N100").ClearContents 

itemnumber = Sheet1.Range("E8").Value 
finalrow = Sheet3.Range("G10").End(xlUp).Row 

Worksheets("Total List").Activate 
For i = 2 To finalrow 
    If Cells(i, 7) = itemnumber Then 
     Sheet3.Range(Cells(i, 7), Cells(i, 12)).Copy 
     Sheet1.Range("B50").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 
     End If 
Next i 

Worksheets("Action Entry").Activate 

Range("E8").Select 


End Sub 

Answer 2

「目に見える」細胞をオートフィルタを使用して貼り付けることが容易になる

' Assumes data starts in cell A1 on each sheet 
Sheet3.range("A1").Autofilter Criteria1:= Sheet1.Range("E8").Value 
Sheet3.range("A1").currentregion.select 
Selection.SpecialCells(xlCellTypeVisible).Select 
Selection.Copy 
Sheet1.Activate 
Sheet1.Range("A1").Select 
Sheet1.Paste