Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7全般 : Excel 2007)
別ブックのシート(複数)の最終空白行に貼付けしたい
投稿日時: 18/04/12 16:24:00
投稿者: いわちゃん

いつも参考にしています。ご教示お願いします。
 
やりたいことは、
 
取引先ファイルの一覧シート
A列に「開始」という文字がある行から、データが入っている最終行S列までをコピー
 
支払先ファイルの複数シートに貼付けたい
・シート数は、11シート
 シートの場所は、左から4シート目〜14シート目
・各シートにはデータが入っており、A列最終空白行に貼付け
 
 
コピーはできたのですが、複数シートへの貼付け方法がわかりません。
よろしくお願いします。

回答
投稿日時: 18/04/12 19:53:07
投稿者: WinArrow
投稿者のウェブサイトに移動

対象シートを認識するのに、何番目という判断は、安全性、確実性の観点から
シート名で判定することをお勧めします。
 
FoR Each Sht In Sheets
    If Sht.Name = "ABC" Or _
        Sht.Name = "DEF" Or _
        Sht.Name "XYZ" Then
のようにしましょう。
 
あと、最終行の取得方法は
  最終行 = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Offset(1).Row
です。

回答
投稿日時: 18/04/12 23:08:06
投稿者: もこな2

WinArrow さんの引用:
対象シートを認識するのに、何番目という判断は、安全性、確実性の観点から、シート名で判定することをお勧めします。
個人的にはシート名を変えられてしまうとうまく動かない可能性があるなど、一長一短なのでルールさえしっかりしてれば何番目という記述でも良いような気はします。
(シートを非表示にして見た目のシート数(順番)と合わないというトラップを仕掛けられる可能性もあるかもですが・・・経験者談)
 
とりあえず、
いわちゃん さんの引用:
コピーはできたのですが、複数シートへの貼付け方法がわかりません
とのことですから、1つのシートには貼付できたってことですよね?
であれば、それを複数シート分繰り返せばよいということになります。
そして、特定のグループに対して繰り返すという方法の一つにFor Each〜Nextステートメントを使うというテクニックがあります。
 
一応、この掲示板では丸投げはダメってことになっているので、1つのシートにコピペするという現状のコードをたたき台に(提示して)して、みなさんに助言を求めてみては如何でしょうか?

回答
投稿日時: 18/04/13 08:34:44
投稿者: mattuwan44

ども
 
まぁ、本当は今こいう感じで書いているくらいの提示はあった方がしてもらった方が、
どの辺までVBAの理解が進んでいるか解って、話をどこから始めたらいいかの見当が、
回答側にも伝わってよいとは思います。
 
多分、コピー元とコピー先ののシート名は同じ名前だと思いますがどうでしょうか?
(そういう情報も出来れば提示していただきたい。けど、そこに気づけるならマクロは作れるかも?
と思うので、やり取りの中で気づいていければいいと思います。)
そうするとコピー元のシート名をNameプロパティで取得して、
その情報で指定したらいいですよね?
WorkBooks("支払先").Worksheets(Workbooks("取引先").Worksheets("○○商事").Name)
もし違うなら関連性をコードの中に盛り込む必要があるでしょう。
 
左から数えた番号でという意見もあるでしょうが、
間違って順番が入れ替わっていても、番号だと間違っているかどうかのチェックが出来るのかな?
間違って、名前を変えてしまう。間違って順番が入れ替わる。間違って削除してしまう。
こういうことを想定したらやはり名前でコピー先を参照するのが良いと思います。
 
もう一個、コピーする前に気を付けることがあります。
それは、「すでにこのマクロは実行されたか。」ということです。
マクロを実行するたびにコピーしても、同じデータがたくさん存在することになります。
この辺はどのようにお考えでしょうか?
 
とりあえず以下に同じ名前のシートにコピペのサンプルを貼り付けておきます。
 
Sub test()
    Const cName As String = "Sheet1,Sheet2,Sheet3"
    Dim ws As Worksheet
    Dim rngTop As Range
    Dim rngBottom As Range
    Dim rngCopyTo As Range
 
    For Each ws In Workbooks("取引先").Worksheets
        Set rngTop = ws.Range("A:A").Find("開始")
        Set rngBottom = ws.Cells(ws.Rows.Count, "S").End(xlUp)
        If Not rngTop Is Nothing Then
            If rngTop.Row < rngBottom.Row Then
                Set rngCopyTo = Nothing
                On Error Resume Next
                With Workbooks("支払先").Worksheets(ws.Name)
                    Set rngCopyTo = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                End With
                On Error GoTo 0
                If Not rngCopyTo Is Nothing Then
                    Application.Range(rngTop, rngBottom).Copy Workbooks("支払先").Worksheets(ws.Name)
                End If
            End If
        End If
    Next
End Sub

回答
投稿日時: 18/04/13 08:39:56
投稿者: WinArrow
投稿者のウェブサイトに移動

もこな2さんレス

引用:
個人的にはシート名を変えられてしまうとうまく動かない可能性があるなど、一長一短なのでルールさえしっかりしてれば何番目という記述でも良いような気はします。
 (シートを非表示にして見た目のシート数(順番)と合わないというトラップを仕掛けられる可能性もあるかもですが・・・経験者談)

ごもっともです。
シートの順番も勝手に変更されてしまうとうまく動作しない可能性があります。
「名前」でも「順番」でも構いませんが
ルールを徹底させることは必要ですが、
若し、変更不可とするならば「ブック保護」する方法があります。
 

投稿日時: 18/04/13 15:13:37
投稿者: いわちゃん

みなさま、ありがとうございました。
 
記載不足で申し訳ありませんでした。
 
シートの位置や枚数は確定されていますが、シート名変更される可能性があるため、シート名を記載しませんでした。
シート名を指定して、作成できました。
ありがとうございました。