ｅｘｃｅｌ正しくリンク貼り付けができません

質問

Ｗindows10,ｍicrosoft365使用の超初心者です。
シート集計を表１、ひょう2にリンク貼り付けするため
次のコードを実行したところ、表2を見ると
E40:AI73でなく、E6:AI39がリンク貼り付けされています。
原因がわかりません。困ってます。よろしくお願いいたします。

Sub 表1にリンク貼り付け()
Dim my_cell
Dim i
Worksheets("集計").Activate
Range("E6:AI39").Select
i = 1
For Each my_cell In Selection
Worksheets("表1").Cells(i, 1).Value = "=集計!" & my_cell.Address
i = i + 1
Next my_cell
End Sub

Sub 表2にリンク貼り付け()
Dim my_cell
Dim i
Worksheets("集計").Activate
Range("E40:AI73").Select
i = 1
For Each my_cell In Selection
Worksheets("表2").Cells(i, 1).Value = "=集計!" & my_cell.Address
i = i + 1
Next my_cell
End Sub

回答No.6

masnoske · ベストアンサー

下記のコードを B.xlsmの標準モジュールに記述してください．

' －－－　ここから　－－－－－－－－－－－－－－－－－
Option Explicit

Public Sub 表1にリンク貼り付け()
Dim wb As Workbook
Dim sh As Worksheet
Dim rng As Range

Set wb = GetBook("C.xlsx")
Set sh = wb.Worksheets("表1")
Set rng = sh.Range("E6:AI39")

Call リンクを作成(sh, rng)
End Sub

Public Sub 表2にリンク貼り付け()
Dim wb As Workbook
Dim sh As Worksheet
Dim rng As Range

Set wb = GetBook("C.xlsx")
Set sh = wb.Worksheets("表2")
Set rng = sh.Range("E40:AI73")

Call リンクを作成(sh, rng)
End Sub

Private Function GetBook(ByVal bkName As String) As Workbook
Dim path As String

' C.xlsxのパスを取得(このブックと同じフォルダにある前提)
path = ThisWorkbook.path & "\" & bkName

' C.xlsxが開いていなければ開く
On Error Resume Next
Set GetBook = Workbooks(bkName)
On Error GoTo 0

If GetBook Is Nothing Then
Set GetBook = Workbooks.Open(path)
End If
End Function

Private Sub リンクを作成(ByVal sh As Worksheet, ByVal rng As Range)
Dim my_cell As Range
Dim i As Long

i = 1
For Each my_cell In rng
sh.Cells(i, 1).Value = "=集計!" & my_cell.Address
i = i + 1
Next my_cell
End Sub
' －－－　ここまで　－－－－－－－－－－－－－－－－－

まずモジュール [表1にリンク貼り付け()]と [表1にリンク貼り付け()]で同じ動作をする部分をモジュール [リンクを作成()]にまとめました．
次に [表1にリンク貼り付け()]と [表1にリンク貼り付け()]のどちらを先に実行するかの規定がないのと，実行前に必ず C.xlsxが開いている保証がないので，C.xlsxが開いていなければ開くモジュール [GetBook()]を双方のモジュールに 追加しました．

お礼

いま試しました。完璧に思う通りのことができ感謝しています。ありがとうございました。

回答No.5

masnoske

別ブックのシートを操作するのなら、このマクロでは無理です。
それとマクロをどこに記述されているのかという先の質問は、
ブックモジュールかシートモジュールか標準モジュールかという意味です。
マクロを記述する場所によってスコープが変わります。
別ブックのシートを操作するのなら、標準モジュールに記述するのが良いでしょう。

回答No.4

masnoske

マクロはどこに記述されていますか？

補足

デスクトップにＡフォルダが表示されています。そのフォルダをクリックするとB.xlsmsとC.xlsxのデータファイルが入っています。マクロは、そのB.xlsmに記述されています。ここのマクロによってC.xlsxのデータファイルを操作したいです。

回答No.3

kkkkkm

通常どちらでも正しく出るのですが、原因不明ですね。
一度新しいブックで試してみてはいかがでしょう。

一応確認ですが
Worksheets("表2").Cells(i, 1).Value = "=集計!" & my_cell.Address
を
Worksheets("表2").Cells(i, 1).Value = my_cell.Address
にして、どのアドレスがセルに代入されるか確認してみてください。

また、
式を入れる場合は.Formulaの方がいいと思います。

Worksheets("表2").Cells(i, 1).Formula = "=集計!" & my_cell.Address

回答No.2

kkkkkm

For Each my_cell In Selection

をそれぞれ

For Each my_cell In Range("E6:AI39")

For Each my_cell In Range("E40:AI73")

に変更してください。

補足

すいません。まちがえてました。ご教示いただいたとおり実行しましたが、依然と表2には正しくリンク貼り付けが出来ません(´；ω；`)ウゥゥ

回答No.1

kkkkkm

For Each my_cell In Range("E6:AI39")

For Each my_cell In Range("E40:AI73")

にして試してみてはいかがでしょう。

補足

Sub 表1にリンク貼り付け()
Dim my_cell
Dim i
Worksheets("集計").Activate
'Range("E6:AI39").Select
For Each my_cell In Range("E6:AI39")
i = 1
For Each my_cell In Selection
Worksheets("表1").Cells(i, 1).Value = "=集計!" & my_cell.Address
i = i + 1
Next my_cell
End Sub
Sub 表2にリンク貼り付け()
Dim my_cell
Dim i
Worksheets("集計").Activate
'Range("E40:AI73").Select
For Each my_cell In Range("E40:AI73")
i = 1
For Each my_cell2 In Selection
Worksheets("表2").Cells(i, 1).Value = "=集計!" & my_cell.Address
i = i + 1
Next my_cell
End Sub
変更しましたら、コンパイルえらー　Ｆｏｒで指令された変数は既に使用されていますとなります。