Excel (VBA)

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

 
(Windows 10 Home : Excel 2010)
データの移動ができません。
投稿日時: 19/07/18 12:38:33
投稿者: x29y6iua

お世話になります。
 
bookA(追加データ)とbookB(既存データ)のファイルがあります。
今回したいことはbookAのそれぞれのシート内のデータをbookBに移すことです。
 
bookAとbookBにそれぞれ複数の名前のシートがあり同一名のシートもあります。bookAにはbookBにない名前のシートもあります。
 
bookAのデータをbookBに移すとき、同一名のシートがあればbookBの最下段にペーストします。bookAにはあってbookBにはない新たな名前のシートデータはシートごと最後尾にペーストします。
 
自分の力量では限界でうまく動作しません。中途半端な状態で申し訳ございません。
全て変更して頂いても構いませんので、ご指導のほどよろしくお願いします。
 
 

Sub testです()

Dim WBn As Workbook, WBo As Workbook
Dim i As Long, x As Worksheet

Application.ScreenUpdating = False

 Set WBn = Workbooks("BookA.xlsm")
 Set WBo = Workbooks("BookB.xlsm")
    
     For i = 1 To Worksheets.Count
        
       For Each x In WBo.Worksheets
            
            If WBn.Sheets(i).Name = x.Name Then
                                              
                WBn.Activate
                    Sheets(i).Select
                        Application.Run "機種範囲選択"
                            Selection.Copy
                WBo.Activate
                  Sheets(x).Select
                     LstRow2 = Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row
                        ActiveSheet.Select
                            ActiveSheet.Range("A" & LstRow2 + 1).Select
                                Sheets(x).Paste
           
           Else
                 WBn.ActiveSheet.Cells.Select
                    Selection.Copy
                        WBo.Activate
                            Sheets.Add After:=Sheets(Sheets.Count)
                                ActiveSheet.Paste
                                    Application.CutCopyMode = False
                                        ActiveSheet.Name = ActiveCell.Value
            
            Exit For
              
            
            End If
        Next
     Next
                        

Application.ScreenUpdating = False
                
End Sub

 
BookA	 A	 B	 C	 D
1	りんご			
2				
3	りんご9			
4	りんご10			
5	りんご11			
6	りんご12			
7	りんご13			
8	りんご14			
9	りんご15			
10	りんご16			
				
				
シート名	りんご	みかん	すいか	とまと


BookB	 A	 B	 C
1	すいか		
2			
3	すいか1		
4	すいか2		
5	すいか3		
6	すいか4		
7	すいか5		
8	すいか6		
9	すいか7		
10	すいか8		
												
			
シート名	とまと	みかん	すいか

 
 
以上です。どうかよろしくお願いいたします。

回答
投稿日時: 19/07/18 13:39:31
投稿者: sk

引用:
bookAのデータをbookBに移すとき、同一名のシートがあればbookBの最下段にペーストします。
bookAにはあってbookBにはない新たな名前のシートデータはシートごと最後尾にペーストします。

Dim WBn As Workbook, WBo As Workbook
Dim WSn As Worksheet, WSo As Worksheet
Dim lngLastRow As Long
 
Application.ScreenUpdating = False
 
Set WBn = Workbooks("BookA.xlsm")
Set WBo = Workbooks("BookB.xlsm")
     
For Each WSn In WBn.Worksheets
    On Error Resume Next
    Set WSo = WBo.Worksheets(WSn.Name)
    If Err.Number = 0 Then
        On Error GoTo 0
        lngLastRow = WSo.Cells(WSo.Rows.Count, 1).End(xlUp).Row
        WSn.UsedRange.Copy WSo.Cells(lngLastRow + 1, 1)
    Else
        Err.Clear
        On Error GoTo 0
        WSn.Copy After:=WBo.Worksheets(WBo.Worksheets.Count)
    End If
Next
 
Application.ScreenUpdating = True
 
Set WBo = Nothing
Set WBn = Nothing
 
------------------------------------------------------------------
 
雑に記述するなら以上のようなフローになるかと。
 
引用:
Application.Run "機種範囲選択"
Selection.Copy

あとは上記のマクロの実行内容次第。

回答
投稿日時: 19/07/18 15:10:36
投稿者: WinArrow
投稿者のウェブサイトに移動

skさんから、レスが浮いていますが、
 
回答者からのコードをそのまま使うのではなく、
自分が記述したコードの問題点を理解することが大切です。
 
まず、先頭ぶぶん

引用:

Set WBn = Workbooks("BookA.xlsm")
Set WBo = Workbooks("BookB.xlsm")
     
     For i = 1 To Worksheets.Count

1行目、2行目で各々のブックをオブジェクト変数にセットしています。
ここで、せっかくオブジェクト変数にセットているにもかかわらず、
3行目
のこーでは、いきなりシートを参照しようとしています。
このままの状態では、どちらのブックのシートなのか?・・・わかりませんよね?
どちらのブックのシートなのかを明記しないと、
その時点でアクティブになっているブックと見做されます。
 
例えば
     For i = 1 To WBo.Worksheets.Count
の様に修飾する必要があります。
どちらを指定するかは、貴方が決めることです。
また、ブックで修飾することでブックの[Select]は基本的に不要です。
このような観点で、以下のコードを見直してみてください。
 

投稿日時: 19/07/18 16:24:35
投稿者: x29y6iua

skさん、ありがとうございました。
頂いた回答を自分なりに検証できてませんが、スムーズに動かせるような感じです。
大変、勉強になりました。
On Error、Err.number等の使い方をもっと勉強してみます。
 
WinArrowさん、ご回答いただきありがとうございました。
ご指摘の所、見直しました。的確なご指摘を頂き感謝いたします。
全然、自分の構文に自信がないもので、ついつい皆様のお力に頼りすぎてしまいます。
skさんの回答も参考にさせて頂き、より自分らしいもの、良いものにしていきたいと思います。
 
skさん、WinArrowさんへのお礼を一緒に書かせてもらい、申し訳ございません。
本当にありがとうございました。