[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『すべてのシートに同じ行に activesheetで選んだ行を挿入』(初心)
activesheetで選んだ行を丸ごとactivesheet以外のすべてのシートに挿入したいんですが、insert メソッドではうまくいかなんですが どうしたらいいですか?
宜しくお願い致します。マクロです。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
(もこな2 ) 2021/09/01(水) 08:02
Sub test()
Dim gyo1 As Range
Dim gyo2 As Range
Dim retcode As Long
Dim i As Long
On Error Resume Next
retcode = 1
Set gyo1 = Application.InputBox("挿入元の行を選択してください", "挿入元の行選択", , , , , , 8)
If Err.Number = 0 Then
Set gyo1 = Union(gyo1.EntireRow, gyo1.EntireRow)
If gyo1.Areas.Count = 1 Then
Set gyo2 = Application.InputBox(gyo1.Address & "の移動先の行を選択してください", "移動先の行選択", , , , , , 8)
If Err.Number = 0 Then
Set gyo2 = Union(gyo2.EntireRow, gyo2.EntireRow)
If gyo2.Areas.Count = 1 Then
gyo1.EntireRow.Copy
For i = 1 To Worksheets.Count
If Sheets(i).Name <> Sheets(1) Then
Sheets(i).Rows(gyo2).Insert Shift:=xlDown ←ここがどうしたものか?
End If
Next
retcode = 0
End If
End If
End If
End If
If retcode <> 0 Then MsgBox "行の移動失敗"
Set gyo1 = Nothing
Set gyo2 = Nothing
On Error GoTo 0
End Sub
(初心) 2021/09/02(木) 00:45
作戦壱:コピーと挿入をセットで繰り返す 作戦弐:作業グループに対して(コピー)挿入する。
のどちらかで考えてみてはどうでしょうか?
Sub 作戦壱()
Dim gyo1 As Range, gyo2 As Range
Dim i As Long
Set gyo1 = Application.InputBox("挿入元の行を選択してください", "挿入元の行選択", , , , , , 8).EntireRow
Set gyo2 = Application.InputBox(gyo1.Address & "の移動先の行を選択してください", "移動先の行選択", , , , , , 8).Cells(1, 1).EntireRow
For i = 2 To Worksheets.Count
gyo1.Copy
Sheets(i).Rows(gyo2.Address).Insert Shift:=xlDown
Next
End Sub
'-------------------------------------------------------------------
Sub 作戦弐()
Dim gyo1 As Range, gyo2 As Range
Dim i As Long
Set gyo1 = Application.InputBox("挿入元の行を選択してください", "挿入元の行選択", , , , , , 8).EntireRow
Set gyo2 = Application.InputBox(gyo1.Address & "の移動先の行を選択してください", "移動先の行選択", , , , , , 8).Cells(1, 1).EntireRow
For i = 2 To Worksheets.Count
Worksheets(i).Select (ActiveSheet.Name <> ActiveSheet.Name) + (ActiveSheet.Name = Worksheets(1).Name)
Next
gyo1.Copy
ActiveSheet.Rows(gyo2.Address).Insert Shift:=xlDown
Worksheets(1).Select
End Sub
(もこな2 ) 2021/09/02(木) 09:09
(初心) 2021/09/03(金) 00:35
要はこういう感じにしたかったのです。
Sub 実験()
Dim i As Long
For i = 2 To Worksheets.Count
If i = 2 Then
Worksheets(i).Select True
Else
Worksheets(i).Select False
End If
Next i
End Sub
(もこな2 ) 2021/09/03(金) 06:22
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.