Excelのマクロを使用して以下の内容をしたいのですがどのようにすれば

質問

Excelのマクロを使用して以下の内容をしたいのですがどのようにすれば宜しいでしょうか？

１）「Ｓｈｅｅｔ１」のセルの値が＞２(２より大きい)の場合に「Ｓｈｅet２」の同一のセルの色を例えば赤色にする。
これをＡ１～Ｎ３４までのセルに関して連続で実行したい。

２）「Ｘ」というファイルのＳｈｅｅｔ１　Ａ１からＮ３４セルに同一のフォルダーに入っている、他のファイルの同セルに値が記載されていれば、その値をコピーしたい。
フォルダーに次々とファイルが追加されていくことを想定し、できれば他のファイル名は指定しなくてもどんどんコピーできるマクロがあればいいと思うのですが・・・

すみませんが宜しくお願いいたします。

回答No.5

keithin

んー？　情報提供の不足は色々ありますが，特に難しい内容では無さそうに思えましたが。

sub macro1()
　dim s as string
　dim myPath as string

　myPath = thisworkbook.path & "\"
　s = dir(mypath & "*.xls")

　application.displayalerts = false
　application.screenupdating = false

　do
　if s <> thisworkbook.name then
　　workbooks.open filename:=mypath & s

　　'コピーしてきたいシートの具体的な詳細が不明
　　workbooks(s).worksheets(1).range("A1:N34").copy

　　'肝心の,どう貼りたいのか，重なったらどうしたいのか等の詳細一切不明
　　thisworkbook.worksheets("Sheet1").range("A1").pastespecial _
　　　Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
　　workbooks(s).close savechanges:=false
　end if
　s = dir()
　loop until s = ""

　application.screenupdating = true
　application.displayalerts = true
end sub

＞色塗り

別にマクロとか使わなくても，シート２のセル範囲を選んで
条件付き書式を取り付けて
セルの値が　→　数式が　に変えて
右の空欄に
=INDIRECT("Sheet1!RC",FALSE)>2
と記入して，書式ボタンでセルの色を赤く塗って出来上がり。です。

回答No.4

tom04

こんばんは！
とりあえず、（1）に関してですが・・・

Sub test()
Dim i, j As Long
For i = 1 To 34
For j = 1 To 14
If Worksheets("sheet1").Cells(i, j) > 2 Then
Worksheets("sheet2").Cells(i, j).Interior.ColorIndex = 3
End If
Next j
Next i
End Sub

こんな感じですかね？

（2）に関してはちょっと判りかねますので
この程度でごめんなさいね。m(__)m

回答No.3

kmetu

Ano2の1)はSheet1のマクロに作成する、それ以外の所にする場合には

For Each m_Range In Worksheets("Sheet1").Range("A1:N34")

としてください。

回答No.2

kmetu

1）
Sub MacroX()

Dim m_Range As Object

For Each m_Range In Range("A1:N34")
If m_Range.Value > 2 Then
Worksheets("Sheet2").Range(m_Range.Address).Interior.Color = vbRed
End If
Next

End Sub

2)
仕様があいまいです
どんどんコピーするとは、たとえばAファイルのA1にデータがありBファイルのA1にデータがあった場合どちらを優先させるのかが不明です。
一度確認したファイルは次の実行時に値をコピーするのかも不明です。
コピーしないとすれば確認したかどうかをどこに記憶しておいて良いのか。
再度流れをじっくり考えて仕様をねってみましょう。

回答No.1

soixante

とりあえず１です。

Sub aaa()
Dim r As Integer, c As Integer
For c = 1 To 14
　　　For r = 1 To 34
　　　　　　If Worksheets("Sheet1").Cells(r, c).Value > 2 Then
　　　　　　　　　Worksheets("Sheet2").Cells(r, c).Interior.ColorIndex = 3
　　　　　　End If
　　　Next r
Next c

End Sub