2016-10-08 6 views
0

以下のコードは、タブの色に基づいてタブを選択します。各シートは同じフォーマットであり、異なる値を含んでいます。私は.findとoffsetを使って特定のセル(現会計年度プラス1に相当する)を見つけて、式の代わりにそのセルをコピーして貼り付けようとしています。以下のコードは必要なタブを選択し、正しいセルを探しますが、そのセルをコピーして値として貼り付けません。このコードは、すべて異なるタブ名を持つ複数のワークブックで使用されるため、特にシート名を付けないようにしています。vbaを使用してワークシート配列に特定のセル(.findを使用)をコピー&ペーストする

Sub freeze() 

Dim ws As Worksheet 
Dim strg() As String 
Dim count As Integer 
count = 1 

For Each ws In Worksheets 
    If ws.Tab.Color = 255 Then 
     ReDim Preserve strg(count) As String 
     strg(count) = ws.Name 
     count = count + 1 
    Else 
    End If 

Next ws 
Sheets(strg(1)).Select 

Dim aCell As Range 
Set aCell = Range("B9:B79").Find(What:=Worksheets("EmailTemplate").Range("A1").Value) 

If Not aCell Is Nothing Then 
Sheets(strg(1)).aCell.Select 
    ActiveCell.Offset(0, 6).Select 
    Selection.copy 
    Selection.PasteSpecial xlPasteValues 
Else 
End If 

    For I = 2 To UBound(strg) 
    Sheets(strg(I)).Select False 

Next I 
End Sub 

あなたがこれを行うことができないあなたに

+0

エラーが発生しましたか?常にエラーとその発生場所を記述してください。 [ここで](http://stackoverflow.com/documentation/excel-vba/1107/vba-best-practices/9292/avoid-using-selector-activate)いくつかのヒントを教えてください) '.Select'などの使い方について – arcadeprecinct

+0

あなたのコードを実行しましたが、もっと情報が必要です。複数のシートを赤(255)にすることはできますか?はいの場合、コード内に複数のシートを使用する規定はありません。赤いシートを見つけて検索に一致するものを見つけたら、同じセルの上にコピーして貼り付けています。それはあなたが欲しいものですか?また、私は 'Sheets(strg(1))aCell.Select'を単に 'aCell.Select'に変更する必要がありました。 –

+0

arcadeprecinctでこれを見ていただきありがとうございます。私は実際には何の誤りもありません。それは単に値として貼り付けません。残りのコードは期待どおりに実行されます。 – HeatherRW

答えて

1

アップデート#2(Sun. 11:15 EDT)あなたをサポートするデバッグステートメントを追加しました。 'Find'コードの 'ActiveSheet'への参照を追加するために必要なのは、すべての 'Red'シートをループし、一致するものがあればそれを見つけ、値をコピー/ペーストします。 デバッグコードには、赤のタブ名、検索値、結果、数式、値が表示されます

Option Explicit 

Sub freeze() 

Dim ws  As Worksheet 
Dim aCell As Range 
Dim strg() As String 
Dim count As Integer 
Dim i  As Integer 

count = 0 

' Get each RED sheet 
For Each ws In Worksheets 
    If ws.Tab.Color = 255 Then      ' Find only RED tabs 
     Debug.Print "-----------------------------------------------------------------------" 
     Debug.Print "Name of Red Sheet: '" & ws.Name & "'"  ' Debug... 
     'ReDim Preserve strg(count + 1) As String 
     'count = count + 1       ' This code not necessary as you can just reference the ws.name 
     'strg(count) = ws.Name      ' Ditto 

     Sheets(ws.Name).Select 
     Set aCell = ActiveSheet.Range("B9:B79").Find(What:=Worksheets("EmailTemplate").Range("A1").value) 
     If Not aCell Is Nothing Then 
      ActiveSheet.Cells(aCell.Row, aCell.column).Select 
      ActiveCell.Offset(0, 6).Select  ' Offset same row, + 6 columns 
      Debug.Print "Found Match for '" & Worksheets("EmailTemplate").Range("A1").value & _ 
       "' in: R" & aCell.Row & ":C" & aCell.column & vbTab & "Formula: '" & ActiveCell.Formula & "'; Value: '" & ActiveCell.value & "'" 
      ' Weird, but was unable to use 'aCell.Select' 2nd time thru loop 
      Selection.Copy 
      Selection.PasteSpecial xlPasteValues 
     Else 
      Debug.Print "Did NOT find a match for: '" & Worksheets("EmailTemplate").Range("A1").value & "' in sheet '" & ws.Name & "'" 
     End If 
     Application.CutCopyMode = False   ' Unselect cell 
    End If 
Next ws 

End Sub 
+0

これをもう一度見ていただきありがとうございます。私は、コピーペーストが働いているのを見ています。私が望む通りではありません。赤いタブの1つから数式を取り出し、それを他のタブに貼り付けています。それぞれの赤いタブには別個の値を計算する式があるので、私はすべての赤いタブにその特定のセルをハードコードし、それぞれ異なる値を保持する方法を探しています。これを手動で行うには、すべてのタブを選択してから、セルを選択し(すべてのタブの同じ場所にある)、コピーして値として貼り付けます。 – HeatherRW

+0

申し訳ありませんが、私はあなたの元の質問を誤解しています。私は本当にあなたの助けに感謝します。私はアレイとループを扱ったのは初めてのことですので、まだたくさんのことを学んでいます。 – HeatherRW

+0

次の点を明確にしてください:(1)同じ赤いシート内に複数の一致があるか、一致するものが1つだけありますか? (2)あなたのコードがすべての赤いシートを見つけたら、最初の赤いシートを最新のものに設定してから検索し、オフセットで指定されたセルをコピー/貼り付けします。 1枚の赤いシートから値をコピーして、他のものに貼り付けることはできますか? (3)各赤のシートは常に同じセルの位置に一致するでしょうか? –

0

ありがとう:

Sheets(strg(1)).aCell.Select 

シートをすでに範囲オブジェクトaCellに格納されています。選択と貼り付けを使わないでください。値は必要ありません。ここで私は何をしますか:

Dim aCell As Range 
Set aCell = Sheets(strg(1)).Range("B9:B79").Find(What:=Worksheets("EmailTemplate").Range("A1").Value) 

If Not aCell Is Nothing Then 
    aCell.Offset(0, 6).Value = aCell.Offset(0, 6).Value 
End If 

私は2番目のループで何を達成したいのか分かりません。 .Selectは私が思う議論を受け入れていないのですか? :実際には.Selectは現在の選択肢を拡張するためにワークシートに適用された場合はreplaceオプションを受け入れます。ごめんなさい!

+0

arcadeprecinct-これらの提案に感謝します。上記のようにコードを調整しました。今すぐコードは正しいシートを選択し、正しいセルを選択しますが、値として貼り付けることはありません。そのセルの値は何らかの理由でまだ数式です。 2番目のループは、私がインターネット上で見つけたコードです。私は、赤以外のタブがすべて選択されていないことを確認するために2回チェックしたと仮定しました。 – HeatherRW

+0

@ arcadeprecinct-私は2番目のループを混乱させました。何がわからないのか分かりませんが、赤いタブがすべて選択されているコードの部分に比べて、1つのタブしか選択されていないことが分かりました。 – HeatherRW

+0

2番目のループのコードは、処理したばかりのシートを「選択解除」します。より良いアプローチは、あなたが始めたシートをフォーカス(つまり選択)することです。 –

関連する問題