Excel (VBA)

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

 
(Windows 7 Professional : Excel 2013)
特定のシートを、値、形式貼り付けの状態で、別BOOKに保存
投稿日時: 17/10/01 14:03:10
投稿者: okabe

お世話になります。
特定のシート(複数)を、値、形式貼り付けの状態で、
別の1つのBOOKに、まとめて保存するにはどうすればよいでしょうか?
以下を作りましたが、よく分かりません。
 
Worksheets(Array("A", "B")).Copy
 
With .UsedRange
                 .PasteSpecial xlValues
                 .PasteSpecial xlFormats
End With
 
 ActiveWorkbook.SaveAs _
     Filename:=ThisWorkbook.Path & "\C" & Format(Date, "yyyymmdd"), _
     FileFormat:=xlOpenXMLWorkbook
     ActiveWorkbook.Close
      
     Set newSheet = Nothing

回答
投稿日時: 17/10/01 14:55:26
投稿者: WinArrow
投稿者のウェブサイトに移動

一度に全部‥は無理でしょうね
 
1つ目、、新しいブックへ複写・・・新しいブックをオブジェクト変数へ
2つ目以降・・・・オブジェクト変数のブックへ複写
 
というように1つづつ複写するようにしましょう。

回答
投稿日時: 17/10/01 15:04:14
投稿者: WinArrow
投稿者のウェブサイトに移動

参考コード
 
Sub test()
Dim NewBook As Workbook
Dim sht As Worksheet
 
    For Each sht In Sheets
        Select Case sht.Name
            Case "Sheet1", "Sheet3"
            If NewBook Is Nothing Then
                sht.Copy
                Set NewBook = ActiveWorkbook
            Else
                sht.Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
            End If
        End Select
    Next
    ' NewBook を保存
 
End Sub

投稿日時: 17/10/01 16:05:27
投稿者: okabe

WinArrow様
 
早速のご回答ありがとうございました。
特定のシートは移動できましたが、値、形式貼り付けの状態になっていないようです。
.UsedRange.Valueをどこかに組み込めばいいと思い、以下にしましたが
うまくいきませんでした。
ご教授頂ければ幸いです。
 
sht.Copy.UsedRange.Value
 
 
Sub test()
Dim NewBook As Workbook
Dim sht As Worksheet
  
    For Each sht In Sheets
        Select Case sht.Name
            Case "Sheet1", "Sheet3"
            If NewBook Is Nothing Then
                sht.Copy.UsedRange.Value
                Set NewBook = ActiveWorkbook
            Else
                sht.Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
            End If
        End Select
    Next
    ' NewBook を保存
  
End Sub

回答
投稿日時: 17/10/01 16:16:40
投稿者: WinArrow
投稿者のウェブサイトに移動

知っている単語を並べれば、何かできる
なんてことはない。
キチンと命令を覚えてほしい。
Sub test()
 Dim NewBook As Workbook
 Dim sht As Worksheet
    
     For Each sht In Sheets
         Select Case sht.Name
             Case "Sheet1", "Sheet3"
             If NewBook Is Nothing Then
                 sht.Copy
                 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
                 Set NewBook = ActiveWorkbook
             Else
                 sht.Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
                 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
             End If
         End Select
     Next
     ' NewBook を保存
   
End Sub
 

投稿日時: 17/10/01 23:16:12
投稿者: okabe

WinArrow様
 
ご対応頂きありがとうございます。
valueで処理しているはずですが、
なぜか処理後のシートは計算式がそのまま残っています。
お手上げです。。

回答
投稿日時: 17/10/02 00:08:25
投稿者: simple

17/10/01 16:16:40 に提示されたコードを実行してみましたが、
想定されたとおりの振る舞いでした。
あなたの実行したコードをそのまま、こちらにコピーペイストしてみてはどうですか?

投稿日時: 17/10/03 00:47:07
投稿者: okabe

simple様
 
ご対応頂きありがとうございます。
私の変えた箇所は、以下A,Bのシート名のみです。
Aは値、形式貼り付けがされていますが、Bのシートは、計算式のあったセルは#REF!と出てしまいます。
別シートの名前を参照するINDIRECT(ADDRESS(〜)関数等使っていますが、そういった関数は値貼り付け出来ない等あるのでしょうか。
 
Sub test()
 Dim NewBook As Workbook
 Dim sht As Worksheet
     
     For Each sht In Sheets
         Select Case sht.Name
             Case "A", "B"
             If NewBook Is Nothing Then
                 sht.Copy
                 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
                 Set NewBook = ActiveWorkbook
             Else
                 sht.Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
                 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
             End If
         End Select
     Next
     ' NewBook を保存
    
End Sub

回答
投稿日時: 17/10/03 06:31:02
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

Aは値、形式貼り付けがされていますが、Bのシートは、計算式のあったセルは#REF!と出てしまいます。
別シートの名前を参照するINDIRECT(ADDRESS(〜)関数等使っていますが、そういった関数は値貼り付け出来ない等あるのでしょうか。

#REF
以外が数式が残っているわけではないですよね?
そこはキチンと確認して下さいね。
 
で、#REF対策
方法は2つ
方法1
別シートも複写してから、後で削除する
しかし、複写する順序までこうりょすると、難しいかも?
 
方法2
複写前に、値に変えてから複写する方法
但し、複写前のブックは上書き保存しないこと。
 
方法2の方が無難でしょう。
 

回答
投稿日時: 17/10/03 07:03:47
投稿者: simple

INDIRECTで例えば"別のシート"を参照するかたちの式になっていたとすると、
シートを新しいブックにコピーした段階で、
その新しいブック内には"別のシート"がありませんから、
#REFとなるのは当然です。
 
方針としては、
・元のブック内でシートを増幅して、
・値だけに修正する
・そのあとで別のブックに移す
と言う風にすれば、エラーになるのを防げるのではないですか?
 
以下、参考コードです。

Sub test()
    Dim NewBook As Workbook
    Dim sht As Worksheet

    For Each sht In Sheets
        Select Case sht.Name
        Case "A", "B"
            sht.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

            If NewBook Is Nothing Then
                ActiveSheet.Move
                ActiveSheet.Name = sht.Name
                Set NewBook = ActiveWorkbook
            Else
                ActiveSheet.Move After:=NewBook.Sheets(NewBook.Sheets.Count)
                ActiveSheet.Name = sht.Name
            End If
        End Select
    Next

    ' NewBook を保存
End Sub

# ActiveSheetを多用していて気にはなるのだが、変数を間に挟むまでもないかと思っています。
# なお、十分な検証をしていないので、そちらでよく確認してください。

回答
投稿日時: 17/10/03 07:06:24
投稿者: simple

投稿してからWinArrowさんの投稿があるのに気づきました。
重なっていると思いますが、事情賢察願います。

回答
投稿日時: 17/10/03 07:54:21
投稿者: WinArrow
投稿者のウェブサイトに移動

シート複写に関して、意図しないところで、意図しない問題発生があり得るので
関係ないかもしれませんが、コメントしておきます。
 
シートを複他ブックに複写する時の副作用として、次があります。
●「名前」も複写される。
  複写するシート以外の定義も複写されます。
 
●表示形式の「ユーザー定義」が複写される
  複写するシートで使っていなくても複写されます。
 
※特に、後者は、理解でき亜いようなエラーに遭遇することがあります。
 

回答
投稿日時: 17/10/03 09:04:37
投稿者: ピンク

おはようございます。
先にNewBookを作成して値の貼付けを行えば如何でしょうか
Sub Test()
    Dim NewBook As Workbook, ws As Worksheet
    Dim i As Long
    Set NewBook = Workbooks.Add(xlWBATWorksheet)
    NewBook.Worksheets.Add After:=Sheets(1), Count:=1
    For Each ws In ThisWorkbook.Worksheets(Array("A", "B"))
        i = i + 1
        ws.Cells.Copy
        With NewBook.Worksheets(i)
            .Range("A1").PasteSpecial Paste:=xlPasteValues
            .Name = ws.Name
        End With
    Next
    'NewBook を保存
End Sub

回答
投稿日時: 17/10/03 17:44:23
投稿者: mattuwan44

一旦シートをコピーして、
改めて値を貼り付けてはいかがでしょうか?
Sub test001()
    Dim shtsOld As Sheets
    Dim sh As Worksheet
    Dim wbNew As Workbook
     
    Set shtsOld = ThisWorkbook.Sheets(Array("A", "B"))
    shtsOld.Copy
    Set wbNew = Workbooks(Workbooks.Count)
     
    For Each sh In shtsOld
        sh.UsedRange.Copy
        wbNew.Worksheets(sh.Name).UsedRange.PasteSpecial Paste:=xlPasteValues
    Next
     
' wbNew.SaveAs Filename:=ThisWorkbook.Path & "\C" & Format(Date, "yyyymmdd")・・・(省略)
End Sub
 
自動で出来るんだから多少効率が悪くても出来ればよし?
時間かかりすぎたら、その時にまた考えましょう^^

投稿日時: 17/10/03 18:47:43
投稿者: okabe

WinArrow様
simple様
ピンク様
mattuwan44様
 
ご協力頂きありがとうございました。
無事やりたかったことが出来ました。
感謝いたします。
 
ポイントをついた質問をしなかったために
煩わせてしまい申し訳ありませんでした。