3番目のセルの値に基づいて2番目の動的セル（特定の行基準）に1つの静的セルの値をコピーします。

Question

名前として'YTDInfo'!$J$2を見て開始するVBAスクリプトがあります。次に、ブックの先頭から一致するシート名を検索し、'YTDInfo'!$J$2のエントリと照合します。名前が見つかった場合は、そのシートの「金額」セルを調べ、その値を'YTDInfo'!$M$2に持ち込みます。

スクリプトは、次の一致するシートに移動します.100枚を超えて、その1人に行われたすべての支払いを追加します。合計合計値はセル'YTDInfo'!$M$2に配置されます。

私はわずか100以上の名前のリストを持っており、このプロセスのコンポーネントを自動化したいと思います。

私は既に持っている：シート名のすべてが取り込ま

'YTDInfo'!A2〜'YTDInfo'!A100 +を。

'YTDInfo'!B2 Marlettフォントで「a」（チェックマーク用）を使用しています。

'YTDInfo'!B2 = "a"（またはB3またはB4 ... = "a"）の場合'YTDInfo'!$J$2は、リストの次の名前（名前はそれぞれA3、A4またはA5に由来します）を入力します。

$J$2には配列CSEの式があります。 'YTDInfo'!$J$2が名前を入力すると、スクリプトを実行し、合計を作成して'YTDInfo'!$M$2に配置します。

このマニュアルが好きなのは、どの名前にYTD情報があるのか​​を追跡でき、重複やスペルミスをシート内で追跡できるためです。

'YTDInfo'!$M$2は私が'YTDInfo'!Fn（nは、行番号の）細胞内に、しかしどこに対応する特定の行に値を配置する必要が移入されたときここで私は今、自動化したいのですが、他のマニュアルの部分は... です名前はから来た。例えば

...

これは、すべてのYTDInfoシートに行われているので、私は情報のその部分にテキストを乱雑に保管しません。 ...と$J$2と$M$2は、スクリプトによって読み取られ、読み込まれた静的なセルだけです。

B11を手動でチェックすると（B11 = "a"）、A12の名前はJ2に渡されます。その名前はジョンです。スクリプトを実行すると、Johnと彼の支払金額（'john 10-17-2017'!AB17 + 'john 10-21-2017'!AB17などのような）を持つシート名のすべてがM2に表示されます。

すべてが$ 12,000と等しいとしましょう。手動で値をコピーして特別に貼り付けなくても、M2（$ 12,000）の値をJohnのYTDセル（F12）にコピーできることをExcelに教えてください。

ありがとうございました。私は単純なExcelのものを知っていますが、私はこれらの部分を把握することはできません。私は式やVBAを使用することを非常に喜んでいます - どんな恐怖、怪しいことなしに！私はあなたの時間のために少し寄付し、あなたから何かを学ぶことができてうれしいです。

Sub YTDTotal_Click() ' 

    Keyboard Shortcut: Ctrl+h 

    Dim mysheet As Worksheet ' 
    Sheets("YTDInfo").Select ' 
    Cells.Clear 

    For Each mysheet In Worksheets 

     mysheet.Select 

     If Left(mysheet.Name, Range("YTDInfo!K2")) = Range("YTDInfo!J2") Then 
      ActiveSheet.Range("H22").Select Selection.Copy 
      Sheets("YTDInfo").Select 
      Range("M2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _ False, Transpose:=False 
     End If 

    Next mysheet 

    Sheets("YTDInfo").Select ' 
    ActiveSheet.Range("H22").Select 

    End Sub 

Answer 1

私はそれを得ました。私は検索して試して泣いてしまいました。入力いただきありがとうございます。私はこれが同様のセットアップや要件を持つ誰かに役立つことを願っています。おそらく、この作業を達成するためのきれいな方法もありますが、私は専門家ではありません。 ...コードがうまく動作していてもエラーが発生しなければ、本当に間違っているとは聞きませんでした。もう少し時間がかかるかもしれませんが、それがうまくいくなら... ...）。

Sub YTDTotal_Click() 
' 
' 
' 
beginScript: 
    If Sheets("YTDInfo").Range("J2") = 0 Then 
     MsgBox "No More Names To Look Up" 
     GoTo LastLine 
    Else 


Dim mysheet As Worksheet 
Dim sheet_name As String 

ActiveSheet.Range("M2").Clear 

For Each mysheet In Worksheets 
mysheet.Select 

If Left(mysheet.Name, Range("YTDInfo!K2")) = Range("YTDInfo!J2") Then 
ActiveSheet.Range("H22").Select 
Selection.Copy 
Sheets("YTDInfo").Select 
Range("M2").Select 
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _ 
    False, Transpose:=False 

End If 

Next mysheet 
Sheets("YTDInfo").Select 
sheet_name = ActiveSheet.Range("J2") 
Z = 200 
Do 
x = x + 1: y = y + 0 
If Range("A" & x) = sheet_name Then Range("F" & x) = Range("M2"): Range("B" & x) = "a" 

If x = Z Then Exit Do 
' Use "Exit Do" for continuous operation 
' Use "Exit Sub" for a one time check 
Loop 
x = 0: y = 0 
End If 

GoTo beginScript 

LastLine: 

End Sub