Excel VBAワークシート名とセル値を一致させ、セルの範囲をコピーして貼り付ける方法

Question

「対象」ブックの一番上のセルが一致しているときに、ブックから別のブックに値をコピーして貼り付けようとしていますワークシートの名前。

しかし、ほとんどの場合、エラー1004が発生しています。何か案は？

Sub Cycle() 

Dim ws As Worksheet 
Dim y As Integer 

For Each ws In ThisWorkbook.Sheets 
      ActiveSheet.Name = Worksheets("Target").Cells(1, y) 
      Worksheets("Target").Range(Cells(2, y), Cells(24, y)).Copy 
      Selection.Copy 
      ActiveSheet.Range("e3").Paste 
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
      :=False, Transpose:=False 

      y = y + 1 


     Next ws 

End Sub 

Answer 1

私は正確に何をしたい理解しますが、この試してみる場合ではないと確信しています：それはそれを行うための最善の方法ではありません

Sub Cycle() 

Dim ws As Worksheet 
Dim wsTarg As Worksheet: Set wsTarg = Worksheets("Target") 
Dim y As Integer 

For Each ws In ThisWorkbook.Sheets 
    y = 1 
    While (wsTarg.Cells(1, y) <> vbNullString) 
     If ws.Name = wsTarg.Cells(1, y) Then 
      wsTarg.Range(wsTarg.Cells(3, y), wsTarg.Cells(25, y)).Value = _ 
       ws.Range(ws.Cells(1, 1), ws.Cells(23, 1)).Value 
     End If 
     y = y + 1 
    Wend 
Next ws 
End Sub 

を（我々は検証の列を避けるために最適化することができること既にコピーされており、ターゲットスプレッドシートを検証しません）、すべてのワークシートを検索し、ターゲットシートの最初の行にあるすべてのセルと比較します。シートの名前がセル名とまったく同じ場合、セル3〜25の最初の列（セル1〜23）がセル3〜25の対象シートにコピーされます。

これが役立ちます。