[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『すべてのシートに同じ行に 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.