1行目の内容をコピーして、他の場所に指定数分だけ
挿入するマクロを作りました。

そのマクロ自体は、正しく動いたのですが、コピー元の1行目に
他のシートを参照する関数が入っていた場合、想定どおりの
結果を得ることができません。

[SHEET1:データのみを記載]
省略

[SHEET2]
A1セル:   =SHEET1!$A1 ←コピー元の行

[マクロ:一部抜粋]
myR = Application.InputBox("挿入する行数を入れてください", , "1")

For i = 1 To myR
  Rows("1:1").Copy
  Cells(ActiveCell.Row, 1).Select
  Selection.Insert Shift:=xlDown
  Selection.EntireRow.Hidden = False
Next i

どういう結果を求めたいかというと、たとえば、
SHEET2のA10セル上で、このマクロを実行し、 "挿入行 = 3" と指定したら

A10:   =SHEET1!$A10
A11:   =SHEET1!$A11
A12:   =SHEET1!$A12

となってほしかったのですが、結果は、

A10:   =SHEET1!$A10
A11:   =SHEET1!$A10
A12:   =SHEET1!$A10

となってしまいました。

どうにか、求める結果を得られるようにできないでしょうか?

このQ&Aに関連する最新のQ&A

A 回答 (2件)

Active.Cellが同一の位置なのだから相対変位しません。



一例です。(ループは不要なので削除しました)
myR = Application.InputBox("挿入する行数を入れてください", , "1")
Rows("1:1").Copy
Rows(ActiveCell.Row & ":" & ActiveCell.Row + myR - 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
    • good
    • 3
この回答へのお礼

ありがとうございます。うまくいきました。

お礼日時:2011/09/30 22:52

下記をやって、その際マクロの記録を採って、これで良いかチェックして。


例データ 例示の書き方も勉強して。
Sheet1 A列
a
b
aa
s
d
f
g
A3の式は =Sheet2!A3
他は手で直接入力。
Sheet2 A1:A9
xx
yy
aa
bb
cc
dd
ee
ff
gg
ーーー
Sheet1で
A3をコピー
A6の「f」の行から3行選択
挿入ーコピーしたセルー下方向にシフト
結果 Sheet1
a
b
aa
s
d
dd
ee
ff
f
g
A6:A8は数式は
=Sheet2!A6
=Sheet2!A7
=Sheet2!A8
---
コードは
Sub Macro4()
Range("A3").Select
Selection.Copy
Range("A6:A8").Select
Selection.Insert Shift:=xlDown
End Sub
これをセル指定の点で一般化するコードに改変する。
もしこれで正しいなら、質問者は
(1)エクセルの操作そのものを十分知らないで(やってみないで)VBAをやっている。
VBAはエクセルの操作でやれることをやれるだけ、なので、エクセルを知らないでVBAをやるのは本末転倒。
(2)マクロの記録の有効性を認識してない
ということになる。
    • good
    • 0
この回答へのお礼

残念ですが、なにを回答したかったのかわかりません。

お礼日時:2011/09/30 22:53

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qなりたい職業とかなかったり、やりたい勉強でないのに大学に行く意味ってありますかね? 勉強したいなら独

なりたい職業とかなかったり、やりたい勉強でないのに大学に行く意味ってありますかね?
勉強したいなら独学でやればいいし、どうせ大学出てもろくな職につけない低い大学とかなら結局出る意味ありませんよね

四年間学費かなりの額払わないと行けないし特に意味がない大学生活四年間なら行く意味ありませんよね?

Aベストアンサー

なりたい職業とかなかったり、やりたい勉強で
ないのに大学に行く意味ってありますかね?
  ↑
大学で勉強する間に、なりたい職業、やりたい
勉強が見つかる場合もあります。

大学のための受験勉強をすることにより
頭脳が鍛えられます。
実質的な差は、実はここにあるのです。
顔つきまで変わります。



勉強したいなら独学でやればいいし、
  ↑
そんなのは、一分の天才以外はムリです。


どうせ大学出てもろくな
職につけない低い大学とかなら結局出る意味ありませんよね
  ↑
それはそうですね。
そんな大学なら、受験勉強などしないだろうし。
しかしです。




四年間学費かなりの額払わないと行けないし特に意味が
ない大学生活四年間なら行く意味ありませんよね?
  ↑
青春時代に遊ぶ、ということはかなり意味が
ありますよ。
人生に対する考え方まで違ってきます。

Qexcel vba 他ファイルマクロ処理中断、自己ファイルマクロ処理後、再度他ファイルマクロ継続方法

excel vbaで、他のEXCELファイルのマクロの処理を中断して、自己ファイルのマクロを処理後、再度他のEXCELファイルのマクロを継続して再度処理を行わせるにはどうすれば良いですか。教えて下さい

他のEXCELファイルとして、フリーソフトを利用しています。
そのソフトは、モジュールにロックが掛ってるので、その中のマクロなどを編集することはできません。(ロック解除などは考えていません。)
そのソフトを起動して、データファイル入力画面で、データファイルを入力して、処理をして、処理結果を保存することを、入力データファイルを変えながら、繰り返し行いたいです。
そこで、処理マクロを作成しています。その手順とVBAを説明します。

1)フリーソフト(違法なものではありません。)を開き、
2)そのフリーソフトのシート内のボタンを、VBAで、マウスカーソルを移動させて、マウスのキー操作で、「押す」「離す」を行い、
3)ファイルの初期化の問合せの警告が出るので、キー操作で、「Y」を押し、
4)データファイルの名称をクリップボードにコピーし
5)EXCELのカレントフォルダを、データファイルのあるフォルダに変えて
6)DoEventsとして、フリーソフトのデータファイル入力画面を開いています。
この時、画面のポインタは、データ入力画面のファイル名入力欄にあり、
この後、データファイル名をクリップボードから入力したいので、
キー操作で、「crtl+v」としたいのですが
フリーソフトのマクロが起動中で、作成している処理マクロに制御が移らないためと思いますが
入力できません。(人手での入力は可能ですが)、自動化したいので、どの様にすれば良いか教えて下さい。
マクロは長いので、抜粋して記載します。

sub a()
(宣言文省略します。)
Workbooks.Open freesoft
Dim mPSet As Long
mPSet = SetCursorPos(b,c)
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
keybd_event VK_Y, 0, fKEYDOWN, 0
keybd_event VK_Y, 0, fKEYUP, 0
Application.CutCopyMode = False
Dim d As New DataObject
With d
.SetText e
.PutInClipboard
End With
ChDrive f
ChDir g
DoEvents
(ここで、止まります。)
With d
.GetFromClipboard
.GetText
End With
keybd_event VK_RETURN, 0, fKEYDOWN, 0
keybd_event VK_RETURN, 0, fKEYUP, 0
DoEvents
Dim mPSet2 As Long
mPSet2 = SetCursorPos(h, i)
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Workbooks(freesoft).SaveAs FileFormat:=xlNormal, Filename:=k
Workbooks(k).Close
End sub

excel vbaで、他のEXCELファイルのマクロの処理を中断して、自己ファイルのマクロを処理後、再度他のEXCELファイルのマクロを継続して再度処理を行わせるにはどうすれば良いですか。教えて下さい

他のEXCELファイルとして、フリーソフトを利用しています。
そのソフトは、モジュールにロックが掛ってるので、その中のマクロなどを編集することはできません。(ロック解除などは考えていません。)
そのソフトを起動して、データファイル入力画面で、データファイルを入力して、処理をして、処理結果を保...続きを読む

Aベストアンサー

フリーソフトに関する詳細が分からないのですが、たぶん、MsgBox、InputBox、または、モーダルのUserFormが表示されたタイミングで、動作待ちになっているものと思われます。動作待ちになるトリガーは、Workbooks.Open freesoftでしょうか?(Open直後にUserFormが表示される?)

であれば、次のように、Shell関数でブックを開くようにすれば良いと思います。
Dim FreeSoft
FreeSoft = Shell("Excel " & "C:\xxxxx\フリーソフト.xlsm",1)
MsgBox "フリーソフトが開くまでの時間稼ぎ!!"
AppActivate FreeSoft

その後は、SendKeysステートメントでフリーソフトを操作することになります。たぶん、mouse_eventやkeybd_event も使えると思います。
ただし、Workbooks(freesoft).SaveAs 等は使えなくなるので、SendKeysによるキーボード操作で保存動作を行う必要があります。

Q捜査行(そうさこう)とはどう意味なのか教えてください。

よく推理小説で「捜査行」という意味が載っているのですが、どうしても意味がつかめません漢字に詳しい方で知っている方どうか教えてくださいお願いします。

Aベストアンサー

「行」という漢字の、一番普通の意味は「行く」です。
「旅に行く」は旅行です。
ANo.1さんのご回答にも出ていますが、短歌や俳句を作りに出かけること(小旅行が多い)を「吟行」といいます。「吟」は「詩吟」の「吟」で詩などを歌うことです。
山の好きな人が山へ行く、登山に行くことを「山行(さんこう)」といいます。
(親の結婚承諾が取れない男女が駆け落ちして)方々を逃げ隠れしながら旅をすることを「逃避行」といいます。
犯人も追っ手を逃れるために、あちこちと「逃避行」をします。

警察も「逃避行」をしている犯人の足取りを追って【捜査行】をします。
また、直接犯人を捕まえるのではなく、証拠を調べるために【捜査行】をすることもあります。

「捜査行」という言葉は、今回のご質問で、はじめて知りました。辞書にもありません。推理小説に出ていたということですから、以上のような意味に取りましたが、当たっていますか(ANo.1さんと同じですが)。

QVBA 最終行・最終列コピー範囲指定における値のみのコピー

下記コード(複数のシートの纏め)で、値のみをコピーする手法を教えて戴きたくお願いします。

Sub matome()
 Dim Sh
 Dim i As Integer
 Dim lRow As Long, lCol As Long, lRow2 As Long
  Application.ScreenUpdating = False
 
 '----列見出しをコピーします
  Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
  '----コピーする順番にシート名を配列Shに登録します
  Sh = Array("Sheet1", "Sheet2", "Sheet3")
  For i = LBound(Sh) To UBound(Sh)
    With Worksheets(Sh(i))
      lRow = .Cells(Rows.Count, 1).End(xlUp).Row
      lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
      If lRow >= 2 Then
        lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Activate
        .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1)
      End If
    End With
  Next i
  Worksheets(1).Activate
  Range("A1").Select
  Application.ScreenUpdating = True
End Sub

下記コード(複数のシートの纏め)で、値のみをコピーする手法を教えて戴きたくお願いします。

Sub matome()
 Dim Sh
 Dim i As Integer
 Dim lRow As Long, lCol As Long, lRow2 As Long
  Application.ScreenUpdating = False
 
 '----列見出しをコピーします
  Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
  '----コピーする順番にシート名を配列Shに登録します
  Sh = Array("Sheet1", "Sheet2", "Sheet3")
  For i = LBound(Sh) To UBound(Sh)
    With Wo...続きを読む

Aベストアンサー

参考になるかわかりませんが
Sub macro2()
Dim Sh
Dim i As Integer
Dim lRow As Long, lCol As Long, lRow2 As Long
Application.ScreenUpdating = False
'----列見出しをコピーします
Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
'----コピーする順番にシート名を配列Shに登録します
Sh = Array("Sheet1", "Sheet2", "Sheet3")
For i = LBound(Sh) To UBound(Sh)
With Worksheets(Sh(i))
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Range("a1").CurrentRegion.Columns.Count
If lRow >= 2 Then
lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
.Activate
.Range(Cells(2, 1), Cells(lRow, lCol)).Copy
Worksheets(1).Cells(lRow2, 1).PasteSpecial Paste:=xlPasteValues
End If
End With
Next i
Worksheets(1).Activate
Range("A1").Select
Application.ScreenUpdating = True
End Sub

参考になるかわかりませんが
Sub macro2()
Dim Sh
Dim i As Integer
Dim lRow As Long, lCol As Long, lRow2 As Long
Application.ScreenUpdating = False
'----列見出しをコピーします
Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
'----コピーする順番にシート名を配列Shに登録します
Sh = Array("Sheet1", "Sheet2", "Sheet3")
For i = LBound(Sh) To UBound(Sh)
With Worksheets(Sh(i))
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
...続きを読む

Q弁護士の追行における、「追行」の意味を教えてください。

サービサー法第11条第2項において、「債権回収会社は、委託を受けて債権の管理若しくは回収の業務を行い、又は譲り受けた債権の管理若しくは回収の業務を行う場合において、次に掲げる手続きについては、弁護士に追行させなければならない。」とありますが、「追行」とはどういう意味ですか。法律用語で一般に使われる「追行」の意味でも結構です。大至急回答いただければ幸いです。

Aベストアンサー

弁護士がその手続をしなければならないという意味です。訴訟手続で主張立証を展開するのに必要な各種申立とか主張立証をすることを、「訴訟を追行する」と言ったりします。質問の背景も分からないので、とりあえずこの位でいいですか?

QVBAで特定の行と一つ上の行を削除するマクロについて

VBA初心者なのでご助力願います。(使用ソフトはエクセル2010)


  A  B  C  D  E  
1            0
2            1
3            0
4            2
5            0
6            1

上記の様にE列に0・1・2の数値が入力されており、2行で1セットのデータになっています。
E列に2が入力された行とその1つ上の行(この場合だと3-4行目)を削除するマクロを教えて頂けないでしょうか?

約15000行あり、手作業では厳しい状態です。
よろしくお願い致します。

Aベストアンサー

空白行を削除し、スピードアップを図るため画面書き換えを止めた物を載せておきます。
-----------------------------------------------------------------
Sub Sample()
Dim 行 As Long
Application.ScreenUpdating = False
行 = Cells(Rows.Count, 5).End(xlUp).Row
Do While 行 >= 2
If Cells(行, 5).Value = 2 Then
Rows(行).Delete Shift:=xlUp
行 = 行 - 1
Rows(行).Delete Shift:=xlUp
End If
If Cells(行, 5).Value = "" Then Rows(行).Delete Shift:=xlUp
行 = 行 - 1
Loop
Application.ScreenUpdating = True
End Sub
-----------------------------------------------------------------
「If Cells(行, 5).Value = "" Then Rows(行).Delete Shift:=xlUp」で空白行削除です
「Application.ScreenUpdating = False」で画面書き換え停止
「Application.ScreenUpdating = True」で画面書き換え再開です

空白行を削除し、スピードアップを図るため画面書き換えを止めた物を載せておきます。
-----------------------------------------------------------------
Sub Sample()
Dim 行 As Long
Application.ScreenUpdating = False
行 = Cells(Rows.Count, 5).End(xlUp).Row
Do While 行 >= 2
If Cells(行, 5).Value = 2 Then
Rows(行).Delete Shift:=xlUp
行 = 行 - 1
Rows(行).Delete Shift:=xlUp
End If
If Cells(行, 5).Value = "" Then Rows(行).Delete Shift:=xlUp
行 =...続きを読む

Q定員割れの地方私立大学に行く意味ありますか?子供が勉強出来ないんですが、大学に行きたいと言っています

定員割れの地方私立大学に行く意味ありますか?子供が勉強出来ないんですが、大学に行きたいと言っています。行けそうな大学の就職先を見ても聞いたことない会社ばかりで、行く意味あるのかなぁと思ってしまいます。無駄に4年老けますし学費ももったいない。高卒で終わったほうがいいような気もしますが実際のところどうでしょう?

Aベストアンサー

同じことを何度も書くのですが、採用資格に大卒が付いているものは結構多いのです。特に公務員は厳しい。だからなんとか這ってでも卒業出来る大学なら行った方が良いでしょう。でも遊び回って最低でも留年を繰り返し始めたら切ると約束したらどうでしょう。

QExcel2007VBAシートコピーとマクロ保存

●質問の主旨
複数のシートのファイルにおいて最終シートだけをコピーし、
かつそのファイルの標準モジュールも含んだファイルを保存するには、
下記のコードをどのように書き換えたらいいでしょうか?
ご存知のかたご教示願います。

●コード
Sub 保存()

Dim flname As String


flname = "D:\医療週報\VBA試作\" & Format(Date, "yyyy年mm月") & ".xlsx"
ActiveSheet.Copy

ActiveWorkbook.SaveAs flname
ActiveWorkbook.Close

End Sub

●質問の補足
1)マクロで「保存」を実行するときは手作業で必ず最終ページを開いています(アクティブにします)。
2)上記コードのうち".xlsx"では最終シートだけをコピーできますが、
マクロの保存ができません。また".xlsm"にするとエラーが出ます。
".xls"にすると複数のシートが全てコピーされた上に、マクロの保存ができていません。
3)私はVBA初心者です。

●質問の主旨
複数のシートのファイルにおいて最終シートだけをコピーし、
かつそのファイルの標準モジュールも含んだファイルを保存するには、
下記のコードをどのように書き換えたらいいでしょうか?
ご存知のかたご教示願います。

●コード
Sub 保存()

Dim flname As String


flname = "D:\医療週報\VBA試作\" & Format(Date, "yyyy年mm月") & ".xlsx"
ActiveSheet.Copy

ActiveWorkbook.SaveAs flname
ActiveWorkbook.Close

End Sub

●質問の補足
1)マクロで「保存」...続きを読む

Aベストアンサー

dradra33 様

こんなのでどうでしょう?

特に質問に記載がなかったので「『マクロを実行するブック』の最終ページ(一番右端と解釈しました)を標準モジュール付きで別名保存する」こととして回答します。
 
それと、結局ファイルの拡張子を何にするのか良く分からなかったのでxlsxにするようにしています。


Sub Tset()
Dim s As Worksheet, flname As String

'保存ファイル名を取得
flname = "D:\医療週報\VBA試作\" & Format(Date, "yyyy年mm月")

'シート削除時のメッセージを非表示
Application.DisplayAlerts = False

'全シートをループ
For Each s In ThisWorkbook.Worksheets

'一番右のシート番号でなければ削除
If s.Index <> ThisWorkbook.Worksheets.Count Then
s.Delete
End If

Next
Application.DisplayAlerts = True

'保存
ActiveWorkbook.SaveAs Filename:=flname, FileFormat:=xlNormal
'xlsmが良ければ、FileFormat:=xlOpenXMLWorkbookMacroEnabled とする
End Sub

dradra33 様

こんなのでどうでしょう?

特に質問に記載がなかったので「『マクロを実行するブック』の最終ページ(一番右端と解釈しました)を標準モジュール付きで別名保存する」こととして回答します。
 
それと、結局ファイルの拡張子を何にするのか良く分からなかったのでxlsxにするようにしています。


Sub Tset()
Dim s As Worksheet, flname As String

'保存ファイル名を取得
flname = "D:\医療週報\VBA試作\" & Format(Date, "yyyy年mm月")

'シート削除時のメッセージを非表示
Appli...続きを読む

Q【日本語】「学があっても教が無ければ意味がない」という日本語はおかしいですか? 大学に行っても優しさ

【日本語】「学があっても教が無ければ意味がない」という日本語はおかしいですか?

大学に行っても優しさ仁愛が無ければ学の意味もなさないっていう意味として言いたいです。

Aベストアンサー

日本では学と教は似たような意味で使われると思います。
教は優しさや仁愛の意味にはならないと思います。
下記のような言葉はありますね。

論語(孔子)の名言集
学びて思わざれば、すなわちくらし、思いて学ばざれば、すなわちあやうし。

<意味>
本を読みあさるだけで自分の思慮を怠ると、 物事の道理が身につかず何の役にも立たない。
逆に思いを巡らすのみで本を読んで学ばなければ、 独断的になり危険だ。
http://earth-words.org/archives/2868

あるいは
https://systemincome.com/7787
人に幸せになってもらいたいと思うなら、思いやりを学びなさい。自分が幸せになりたいと思うなら、思いやりを学びなさい。
ダライ・ラマ14世

他にも
https://matome.naver.jp/odai/2136819783259619101
人にして信なくんばその可なるを知らず。『論語』
どれほど頭が良く優秀な人材であろうとも、人に信用されず、人を信用することもできぬ人物を誰が相手にするだろうか。肝心なことを取り違えてはいけない。

日本では学と教は似たような意味で使われると思います。
教は優しさや仁愛の意味にはならないと思います。
下記のような言葉はありますね。

論語(孔子)の名言集
学びて思わざれば、すなわちくらし、思いて学ばざれば、すなわちあやうし。

<意味>
本を読みあさるだけで自分の思慮を怠ると、 物事の道理が身につかず何の役にも立たない。
逆に思いを巡らすのみで本を読んで学ばなければ、 独断的になり危険だ。
http://earth-words.org/archives/2868

あるいは
https://systemincome.com/7787
人に幸せになって...続きを読む

QVBAのコピーマクロがデバッグに引っかかる

下記コピーマクロで1/2度成功(!)しましたが、以後うまく動かず難渋しています。更に断続的に更に3/4カ所列を追加したいのですが、見本と同様に列名を入れて冗漫に下記並べるしか他に方法はありませんか?

Sub 全てのエリアに式をコピーする()
Sheets("WORK").Select

'Range("O5:O5").Select
'Selection.Copy


'Sheets("WORK").Select
'Range("O5:O2000").Select
'ActiveSheet.Paste

End Sub

Aベストアンサー

Sub 全てのエリアに式をコピーする2()
 With Worksheets("WORK")
      .Range("O5").Copy .Range("O5:O2000")
 End With
End Sub

とか。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報