Excel (VBA)

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

 
(Windows 8.1 : Excel 2016)
シート間コピー
投稿日時: 18/11/05 11:16:20
投稿者: 丘珠

下記マクロでAブック、Bブックとも立ち上げた状態からAブックからBブックへコピーをしています。
仮にAブックのA1に記載があればA2へコピー、A2に記載があればA3へとコピスる方法はありますか。
 
Sub Macro1()
    Dim wb As Workbook
    Dim i As Long
    If Workbooks.Count <> 2 Then Exit Sub
    For i = 1 To 2
        Set wb = Workbooks(i)
        If Not wb Is ThisWorkbook Then
           Exit For
        End If
    Next
    
    'Workbooks.Open Filename:="S:\AB\新しいフォルダー\"
    Sheets("貼りつけシート").Select
    Rows("2:2").RowHeight = 12.75
    Rows("2:2").Select
    Range("AW2").Activate
     
   For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If (Cells(i, 1) = "") Then
Cells(i, 1) = Cells(i - 1, 1)
End If
Next i
 
     
    Selection.Copy
    Windows("AB依頼票.xls").Activate
    Rows("2:2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

回答
投稿日時: 18/11/05 13:36:34
投稿者: WinArrow
投稿者のウェブサイトに移動

コードをしっかり読んでいませんが、
 
「異なるブック間のセルの複写」コードを記述する場合
どのブックのどのシートのセルなのかを明示するようにコードを記述しないと
読んでいてわからなくなります。
 

Dim wbk1 As Workbook,wbk2 As Workbook
 
Set wbk1 = Workbooks("Book1")
Set wbk2 = Workbooks("Book2)
 
Book1のSheet1のセルA1をBook2のSheet1のセルB1に複写する場合
 
wbk1.Sheets("sheet1").Range("A1").Copy Destination:=wbk2.Sheets("sheet1").Range("B1")
 
これが理解できたら、参考に、コードを書き直してみませんか?

投稿日時: 18/11/06 08:39:51
投稿者: 丘珠

これが理解できたら、参考に、コードを書き直してみませんか?
 
色々やってみましたが出来ませんでした。素人には無理かな

回答
投稿日時: 18/11/06 10:36:44
投稿者: WinArrow
投稿者のウェブサイトに移動

丘珠 さんの引用:
これが理解できたら、参考に、コードを書き直してみませんか?
 
色々やってみましたが出来ませんでした。素人には無理かな

 
コードは理解できたのでしょうか?
 
> Sheets("貼りつけシート").Select
このコードは、この時点でアクティブになっているブックが対象となります。
ですから、このコードだけでは、どのブックを対象にしているかわかりませんから、
対象とするブックを明示する必要があります。
 
セルについても同様です。
セルは、シートの中にありますから、シートを明示するが、シートはブックの中にあるから、
更にブックを明示する
といった具合です。
 
>仮にAブックのA1に記載があればA2へコピー、A2に記載があればA3へとコピスる方法はありますか。
↑の文章についても
なんとなくわかるのですが
最初の「A1」には、Aブックという説明がありますが、シート名が分かりません。
 
ですから
> Sheets("貼りつけシート").Select
このシートはAブックなのか?Bブックなのかが分かりません。
 
回答者はあなたのPCの画面は見えませんから、
もっと具体的な説明(他人にも見えるように)がないと、
あなたが意図しているようなアドバイスができないわけです。
 

回答
投稿日時: 18/11/06 10:41:26
投稿者: WinArrow
投稿者のウェブサイトに移動

もう少し追加すると
説明の中のAブック、Bブックが
コードの中では、別の名前になっています。
 
説明とコードは対応させないと他人には理解してもらえないと思います。

回答
投稿日時: 18/11/06 11:23:15
投稿者: WinArrow
投稿者のウェブサイトに移動

コード内容の添削・・・・理解できないところは疑問符がついています。
 
第1ブロック

引用:

    If Workbooks.Count <> 2 Then Exit Sub
     For i = 1 To 2
         Set wb = Workbooks(i)
         If Not wb Is ThisWorkbook Then
            Exit For
         End If
     Next

ここまでは、AブックとBブックの両方が開いていることが分かります。
しかし、説明では
>下記マクロでAブック、Bブックとも立ち上げた状態
とあり、マクロで開くのか・・・と思いきや、すでに開かれている
のですね?
説明文は
Aブック、Bブックとも立ち上げた状態でから、下記マクロで
とした方が誤解されないと思います。
 
 
第2ブロック
引用:

     'Workbooks.Open Filename:="S:\AB\新しいフォルダー\"
     Sheets("貼りつけシート").Select
     Rows("2:2").RowHeight = 12.75
     Rows("2:2").Select
     Range("AW2").Activate
 

コードそのものは間違っているとは思いませんが、
このブロックで指定しているシート(貼りつけシート)は、
どちらのブックのシートなのかわかりません。
雰囲気的には、複写先のブックかな?
と思います。
以降の処理との関連で、考えると複写元とも考えられます。
複写元ならば、なぜ、行高を設定(変更?)する必要があるのだろうか?
 
 
第3ブロック
引用:

 For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
 If (Cells(i, 1) = "") Then
    Cells(i, 1) = Cells(i - 1, 1)
 End If
 Next i
 

このブロックは、説明の中の
>AブックのA1に記載があればA2へコピー
の部分と思いますが、
第2ブロックでアクティブブックが複写先であると仮定すると
矛盾します。
 
第4ブロック
引用:

     Selection.Copy
     Windows("AB依頼票.xls").Activate
     Rows("2:2").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False

 
先頭に
>Selection
とありますが、
これ以前にセル範囲を選択しているところは、
>Rows("2:2").Select
しかない。
> Rows("2:2").Select
このコードは、貼り付ける場所を選択していると思いますが、
2行目だけでよいのか?
貼り付けオプションには、Valueを指定しているから
第2ブロックの
> Rows("2:2").RowHeight = 12.75
は、どんな意味があるのか?
また、
第3ブロックの処理は、何のためにあるのか?????
不明です。

回答
投稿日時: 18/11/06 13:00:09
投稿者: もこな2

結構話がすすんじゃってますが、今朝見たコードを私なりに直すと↓になります。
 

引用:
Sub Macro1改()
    Dim tmpRNG As Range
 
    '元データがあるシートの操作
    With ThisWorkbook.Sheets("貼りつけシート")
        'A2〜A列最終行までのセル範囲
        With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))

            '数式で""になっているのではなく、純粋なブランクであれば↓でもよさそう
            On Error Resume Next
            Set tmpRNG = .SpecialCells(xlCellTypeBlanks)
            On Error GoTo 0
 
            If Not myRNG Is Nothing Then
                myRNG.Formula = "=" & myRNG(1).Offset(-1).Address(False, False)
                myRNG.Value = myRNG.Value
            End If

        End With
 
        'ここからは2行目だけに限定した操作
        With .Rows("2:2")
            .RowHeight = 12.75
            .Copy
        End With
 
 
    '貼付先シートの操作
    With Workbooks("AB依頼票.xls").Worksheets(1)
        .Rows("2:2").PasteSpecial Paste:=xlPasteValues
    End With
 
End Sub

こうしてみると、
・行の高さを変えているけど、値貼付してるので意味があるのかな〜
・A列全体のブランク?セルに値を入れてる割には、コピペ対象は2行目だけなので意味あるのかな〜
なんて思います。

回答
投稿日時: 18/11/06 14:19:42
投稿者: WinArrow
投稿者のウェブサイトに移動

 
追加レス
  
説明では、ブックが2つ登場していますが、
もう一つ、コードが記述されているブックが隠れています。
  
@Aブック
ABブック
Bマウロブック
  
しかし、
@とBが同一ブックということもあり得ます。
AとBが同一ブックということも考えられます。
Bを独立させることも考えられます。
  
雰囲気的には、@とBが同一ブックかな?
だとしたら
これは、マクロ実施前にブックが開かれているので、
特に意識しない限り、複写先ブックがアクティブうっくになりますから、
コード作成に当たっては、十分注意しなければいけないことになります。
 
ABブックとBマクロブックが同一ならば、アクティブブックは、複写元ブックになる。
 
Bマクロブック(独立)ならば、どちらを最初に開くかでアクティブブックが決まる。
 
掲示のようなブックもシートも明示しないコードを記述する場合、
常に「アクティブブック、アクティブシートがなんであるかを意識する」が絶対条件です。
  
   
 
 

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

WinArrowさんがコメントされてますが別路線で。
 
まず、質問とは関係ないですが、↓が放置されてるので何とかしたほうがよいでしょう。
https://www.moug.net/faq/viewtopic.php?t=77114
 
とお小言みたいな事はここまでとして、このトピックの質問を推測しながら整理すると
 
【A】ブックの【アクティブな】シートの【A1】セル
 ↓
【B】ブックの【貼りつけシート"】シートの【A2】セル
 
 
【A】ブックの【アクティブな】シートの【A2】セル
 ↓
【B】ブックの【貼りつけシート"】シートの【A3】セル
 
のように、コピー元のシートのブランク以外のセルを、貼付先の1行ずれた位置にコピペしたいということですよね。
 
この推測が合ってればですが、提示されたコードだと、なかなかにゴールから遠そうなのでとりあえずヒントを。
 
まず、ブランク以外のセルを探す方法を考えてみましょう。
手動操作でブランク以外のセルを”選択”するには
 (1) あらかじめ調べたい範囲を選択しておく
 (2)「Ctrl」+「G」を同時押し
 (3)「セル選択」をクリック
 (4)定数をクリック(チェックは入ったまま)
 (5)OKをクリック
のように操作すると、該当のセルが”選択”されます。
これを、「マクロの記録」でExcel君にコード化してもらうと、どのような命令を使うと値が入ってるセルが選択されるのかがわかるコード手に入りますから、そこからセルを”取得”する方法もわかるかと思います。
 
次に、1行下にコピーする方法について考えてみましょう。
いきなりは難しいかもしれませんので、一旦"同じセル番地"にコピペする方法を考えてみましょう。

 Workbooks("コピー元.xls").Worksheets(1).Range("A1").Copy
 Workbooks("貼付け先.xls").Worksheets(1).Range("A1").Paste
おそらくこんな感じになるでしょう。
これをヒントに、セル番地の文字列は変えずに貼り付け先を”1行下にずらす”方法を考えてみましょう。



おそらくこんな感じのものを思いつくのではないでしょうか?
 Workbooks("コピー元.xls").Worksheets(1).Range("A1").Copy
 Workbooks("貼付け先.xls").Worksheets(1).Range("A1").Offset(1, 0).Paste
ここまで来たら折り返し地点です。
何度も書くのもめんどくさいので、コピー元のセルを変数に入れることを考えてみましょう。
ついでにごちゃごちゃ書くのもめんどくさいので、貼り付け先の”シート”も変数に入れておきましょう。
Sub test()
    Dim MyRNG As Range
    Dim 貼付先SH As Worksheet
    
    Set MyRNG = Workbooks("コピー元.xls").Worksheets(1).Range("A1")
    Set 貼付先SH = Workbooks("貼付け先.xls").Worksheets(1)
    
    MyRNG.Copy
    貼付先SH.Range("A1").Offset(1, 0).Paste
 
End Sub
こんな感じになり、結構すっきりしますよね。
さらに、ただのコピペなら、わざわざPasteメソッドを使わずとも、Copyメソッドの引数として貼付先を指定してやれば1行で記述することができますから、上記は
Sub test()
    Dim MyRNG As Range
    Dim 貼付先SH As Worksheet
    
    Set MyRNG = Workbooks("コピー元.xls").Worksheets(1).Range("A1")
    Set 貼付先SH = Workbooks("貼付け先.xls").Worksheets(1)
    
    MyRNG.Copy 貼付先SH.Range("A1").Offset(1, 0)
 
End Sub
と記述してもOKです。
 
長くなったので次投稿へ続きます。

回答
投稿日時: 18/11/06 23:39:59
投稿者: もこな2

前投稿から続く。

引用:
Sub test()
    Dim MyRNG As Range
    Dim 貼付先SH As Worksheet
     
    Set MyRNG = Workbooks("コピー元.xls").Worksheets(1).Range("A1")
    Set 貼付先SH = Workbooks("貼付け先.xls").Worksheets(1)
 
    MyRNG.Copy 貼付先SH.Range("A1").Offset(1, 0)

 
End Sub
さて、↑の赤字部分をよく見てください。このままだと貼付先はA1セルから1行下がったセルで固定されててしまってますよね。
でもよく考えてください。そもそもA1セルってどっからきたんでしょうか?



コピー元がA1セルだからでしたよね。
つまり、貼付先はA1セルから1行下がったセル・・・ではなく、貼付先は、貼付先シートのうち、コピー元のセル番地のセルから1行下がったセルとも言えることになります。
都合よく、コピー元セルは変数に格納されてますので、今回はこれを使いましょう。
引用:
Sub test()
    Dim MyRNG As Range
    Dim 貼付先SH As Worksheet
     
    Set MyRNG = Workbooks("コピー元.xls").Worksheets(1).Range("A1")
    Set 貼付先SH = Workbooks("貼付け先.xls").Worksheets(1)
     
    MyRNG.Copy 貼付先SH.Range(MyRNG.Address).Offset(1, 0).Paste
  
End Sub
ここまで書くと、ピンとくるかもしれませんが、MyRNGにコピー元のセルを次々に入れて、コピペする部分を繰り返せば、目的は達成できそうですよね。
 
そういう時に便利なのがFor Each〜Nextステートメントです。
そのものズバリを書いてしまうと、考える機会を奪ってしまうので、とりあえずボカしますが、
Sub Sample()
    Dim MyRNG As Range
    
    For Each MyRNG In セルの集まり
        '処理
    Next MyRNG   
End Sub
↑のようなコードを使うと、今回質問されたようなことはできると思います。

投稿日時: 18/11/07 08:49:29
投稿者: 丘珠

WinArrowさんもこな2さん細かいご指導ありがとうございます。
昨夜いろいろチャレンジいたしましたがうまくいきません、もう少しVBA勉強してからチャレンジしようと思います。

回答
投稿日時: 18/11/07 09:16:18
投稿者: WinArrow
投稿者のウェブサイトに移動

丘珠 さんの引用:
WinArrowさんもこな2さん細かいご指導ありがとうございます。
昨夜いろいろチャレンジいたしましたがうまくいきません、もう少しVBA勉強してからチャレンジしようと思います。

 
ようやくお出まし?
 
チャレンジする前に、整理してみましょう。
最初の説明文
引用:
下記マクロでAブック、Bブックとも立ち上げた状態からAブックからBブックへコピーをしています。
 仮にAブックのA1に記載があればA2へコピー、A2に記載があればA3へとコピスる方法はありますか。
 

を分解すると
>Aブック、Bブックとも立ち上げた状態AブックからBブックへコピーをしています。
は、前提条件としての説明は、まあ、いいでしょう。
次の
>仮にAブックのA1に記載があればA2へコピー、A2に記載があればA3へとコピスる方法
この部分は、
説明文だけで考えると(文章の足りないところがあるが)
AブックのA1に記載があれば「Bブックの」A2へコピー、
と推測できます。
しかし、掲示してあるコードが邪魔をして、
複写元である自シートのA2へコピーとも受け取れる
ということです。
後者であるならば、十分機能している(不明な部分もあるが)と思いますので
コピペする方法はあるか?
という質問にならないだろうと思います。
 
このように、意図する内容をきちんと正確に表現できるように
@現状の状態
A意図する内容
B掲示したコードで実行した内容
C意図する内容と実行結果がどのように異なるか
というような整理をしてみましょう。
 
あやふやな情報だけでは、議論できないし、
現実、キャッチボールにもなっていないですね・・・
 
 
 

投稿日時: 18/11/07 11:01:39
投稿者: 丘珠

WinArrowさん細かくアドバイスいただきありがとうございます。
自分の文書能力、エクセル技量不足を痛感いたしました。
勉強したうえで再挑戦させていただきます。。