ExcelのVBAを教えて下さい。

Question

シート①をコピーしてシート②にペーストしたいと考えています。(ボタンクリックして命令実行型)

シート①の範囲内の中から最後の行をコピーしてシート②の範囲の最初にペーストしたいです。
例えば、シート① H8からAA8の行からH47からAA47行までの間で最後の行入力したセル行『　I 列 だけコピーしない』をコピーして、 シート②のH8からAA8の行にペーストその時に『 I 列 だけペーストしない。シート名が変わっても対応出来る様にしたいと考えています。

どの様にしたら良いのか教えて下さい。

WindFaller · Accepted Answer

遅くなりました。

>②シートの最後をコピー③にペーストと追加はどの様にすればいいでしょうか。
私は、今書いている内容が、ご質問者さんの環境にあっているのかどうか、分からないのです。
私が書いたマクロも、他人からみればまったくわけが分からない内容かもしれません。

それで、具体的なマクロとは別の基本的な話ですが、
コピー＆ペーストする時に、ペースト側のセルをデフォルトに戻してしまえば、貼り付けのエラーは起こらなかったと思います。
それは、貼り付け先の行、Cells(i, j).Resize(1,20).Clear   とすれば、20列は、デフォルト状態になってしまいます。

もう一つ、ペーストする時に形が違うとか言ってくるアラートがありますが、それは、レンジ to レンジではなくて、レンジ to 1個のセルというスタイルにすれば、アラートから逃げられます。
以下でいうと、
　copyRng.Offset(, 3).Resize(, j - colStart - 1).Copy dstRng(3)　'後は三番目から
このようなスタイルで、dstRng というのは、目的のレンジですが、それに、(3 ) とすれば、横長1行の場合のみに、3列目という意味になります。

'//
Sub PasteVariableMacro()
　Dim sh2 As Worksheet
　Dim sh3 As Worksheet
　Dim i As Long, j As Long, m As Long
　Dim copyRng As Range, dstRng As Range
　Dim colStart
　
　colStart = 8 '列の基点
　
　Set sh2 = ActiveSheet 'Worksheets("シート2")
　Set sh3 = Worksheets("シート3")
　
　i = sh2.Cells(Rows.Count, "H").End(xlUp).Row 'シートのH列の最後
　
　If i > 7 Then '8行目以上なら、
　　j = sh2.Cells(i, Columns.Count).End(xlToLeft).Column '右端の列を検索
　　If j - 8 > 1 Then 'H列=8 よりも1列以上多ければ、
　　　Set copyRng = sh2.Cells(i, "H").Resize(1, j - colStart) '変数に入れる
　　　
　　　'//貼り付け先の検索
　　　m = sh3.Cells(Rows.Count, "H").End(xlUp).Row 'シート3の同じくH列の最後を探す
　　　If m < 8 Then '8行目以下なら、8行目
　　　　m = 8
　　　ElseIf m = 8 And sh3.Cells(m, "H").Value = "" Then '8行目が空なら8行目を埋める
　　　　m = 8
　　　　Else '通常なら､データある行よりも一つ下
　　　　m = m + 1
　　　End If
　　　Set dstRng = sh3.Cells(m, "H").Resize(, j - colStart) 'コピーの貼り付け範囲を決める
　　　'copyRng.Copy dstRng(1) '貼り付け先には、セル一つを指定する。
　　　
　　　'//2列目をコピーしない (上記とは反する
　　　　 copyRng(1).Copy dstRng(1)　　　 '先頭はコピー
　　　 copyRng.Offset(, 3).Resize(, j - colStart - 1).Copy dstRng(3)　'後は三番目から
　　　
　　　MsgBox "OK"
　　End If
　End If
End Sub

WindFaller · Answer

#2の回答者です。
>Private Sub Workbook_SheetChangeは使っている為、出来ません。

これは条件さえ異なっていれば2つでも3つでも、イベント機能は付けられますが、また、同じような目的なら、そのコードに組み込ませてもよいだろうとは思います。単に、最後の入力した場所をグローバル変数に入れるだけのことですから、大した作業はしていません。そこらは、各シート別のイベントのPrivate Sub Workbook_Change　に書き換えれば済みます。

ただ、Private Sub Workbook_Change　や Private Sub Workbook_SelectionChange なら分かるけれども、ThisWorkbook イベントの「Private Sub Workbook_SheetChange」をお使いになっている方なら、#2のマクロは組み込めないはずはないと思います。

なぜ、私がThisworkbook のイベントを使ったかというと、
「シート名が変わっても対応出来る様にしたいと考えています。」
ということで、シート②が固定でコピーしたものを貼り付けるとして、後は、データはコピーされる側だと思うからです。
だから、シート②を固定して、後は、ActiveSheet にしたわけです。

>シート名は変えず①とシート名でいきたいと思います。
>現状では、Sheet8が①のシート名　Sheet9が②のシート名
>Sheet11が③と飛んでいる様になっています。

これにもついても、コピーしたものを受けるシートが、
　Sh.Name = "シート②" 
他のシートは、mShN 　ここにシート名が格納させるということなのですが……。だから変える必要もありませんし、Sheet10 がないのなら、

If Sh.Name = Worksheets("Sheet10").Name Then Exit Sub と一行加えればよいはずです。

こういう仕組みは分かってはいただけないでしょうか。
たぶん、最近の傾向では、私の説明はほとんど理解されないことが多くなってきていますから、お分かりにならないようでしたら、他の方をお待ちになってください。

WindFaller · Answer

こんにちは。一見単純そうですが、ずいぶん難しそうな話だと思います。解釈の仕方によって大幅にコードが変わってくるのですが、私は一般的な解釈をしないせいなのか、ほとんど的外れのようです。シート① H8からAA8の行からH47からAA47行までの間で最後の行入力したセル行最後の行入力したセル行とは？　ふつうのマクロなら最終行となりますが、H8からAA47までの範囲で、最後に入力したセルを特定しなければなりません。いわゆるChangeイベントですが、そのままではその場所は保有していませんから、モジュール・スコープ変数を用意しておかなくてはなりません。そして、イベントが発生したら、そのモジュール変数に格納します。『　I 列だけコピーしない』をコピーして、H列からAA行で、I列を抜くというのは、ふたつに分けることしか思いつきません。すなわち、Hと、J列からAA列　ということになるはずです。・シート名が変わっても対応出来る様にしたいと考えています。これを別な見方をすると、コピーの貼り付け場所は一定ということかもしれません。コピーされる側は任意のシートということですと、最初のモジュール・スコープ変数というものが複雑なる思います。（グローバル変数に変更する）シート②のH8からAA8の行にペーストについては、H8からAA8 の行に加えていくと解釈しました。(ここの解釈によってコードが変わります）私が書いても、最近は、ここでは私のマクロは、受け入れられないようですが、誰かの先駆けとしては良いかもしれません。もっと単純な内容を好まれているような気がします。 '// '標準モジュール Public mShN As String　　'グローバル変数に変更 Public mRow As String　　'グローバル変数に変更 Sub LineCopying() Dim Rng As Range Dim LastRow As Long Set sh2 = Worksheets("シート②")　　'←シート②を登録 If mShN <> "" And mRow <> "" Then 　　Set Rng = Worksheets(mShN).Rows(mRow) 　　LastRow = sh2.Cells(Rows.Count, 8).End(xlUp).Row 　　If LastRow < 8 Then 　　　LastRow = 8 　　ElseIf LastRow = 8 And sh2.Cells(LastRow, 8).Value = "" Then 　　　LastRow = 8 　　Else 　　　LastRow = LastRow + 1 　　End If 　　Rng.Cells(1, "H").Copy sh2.Cells(LastRow, "H") 　　Rng.Cells(1, "J").Resize(, 18).Copy sh2.Cells(LastRow, "J") 　　mShN = "" 　　mRow = "" End If End Sub '------------- 'ThisWorkbook モジュール Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 　If Sh.Name = "シート②" Then Exit Sub 　If Target.Cells(1).Value = "" Then Exit Sub 　If Intersect(Target, Range("H8:AA47")) Is Nothing Then Exit Sub 　mShN = Sh.Name 　mRow = Target.Rows(1).Row End Sub

くんこば · Answer

マクロの自動記録を使ってみてください。
それで生成されたソースコードをいじればすぐできます。

ExcelのVBAを教えて下さい。

遅くなりました。

#2の回答者です。

こんにちは。

マクロの自動記録を使ってみてください。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング