VBA貼り付け先のワークシートを選択するときにセルを参照するコード

Question

このコードを変更してセルA6のデータを参照し、そのデータの名前付きシートに貼り付けることができますか？

すでにカバーシートから個々のワークシートにデータを貼り付けるための作業マクロがあります。これは、毎日、以前に入力したセルを上書きしません（下記参照）。

問題は、コードがあまりにも明確で、新しい行が「バランサー」表紙に導入されたときに簡単に操作できないことです。この場合にはA6（、私はコードが「バランサー」タブのレンジ「B6」のデータをコピーしたい

Sub pastetosheet() 

r = 1 
Sheets("Balancer").Range("B2").Copy 
Sheets("X9X9USDFEDT6").Range("C35").End(xlUp).Offset(r, 0).PasteSpecial _ 
    paste:=xlPasteValues 
Application.CutCopyMode = False 
Sheets("Balancer").Range("D2").Copy 
Sheets("X9X9USDFEDT6").Range("D35").End(xlUp).Offset(r, 0).PasteSpecial _ 
    paste:=xlPasteValues 
Application.CutCopyMode = False 
Sheets("Balancer").Range("F2").Copy 
Sheets("X9X9USDFEDT6").Range("F35").End(xlUp).Offset(r, 0).PasteSpecial _ 
    paste:=xlPasteValues 
Application.CutCopyMode = False 
Sheets("Balancer").Range("G2").Copy 
Sheets("X9X9USDFEDT6").Range("H35").End(xlUp).Offset(r, 0).PasteSpecial _ 
    paste:=xlPasteValues 
Application.CutCopyMode = False 
End Sub 

、左側にセルのデータを参照します。ここでは、現在のコードの例です。どの用紙を貼り付けるかを知るため）。次に、現在のコードからペーストルールを使用します。

Answer 1

各行は列Aで、独自の宛先シートを指定している場合、これは実行する必要があります。

Sub pasteToSheetOfA() 
    Dim r As Long, t As Range 
    With Sheets("Balancer") 
     For r = 1 To .Range("B1000000").End(xlUp).Row ' for all rows of column B 

      ' get the target sheet specified in column A, goto beyond last cell in C of this sheet 
      Set t = Sheets(.Range("A" & r).value).Range("C1000000").End(xlUp).Offset(1) 

      ' now copy the cells of the row according to the rules of the OP 
      t.value = .Cells(r, "B").value 
      t.Offset(,1).value = .Cells(r, "D").value 
      t.Offset(,3).value = .Cells(r, "F").value 
      t.Offset(,5).value = .Cells(r, "G").value 
     Next 
    End With 
End Sub