Excel (VBA)

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

 
(指定なし : Excel 2010)
特定の文字を含むシートを選択し、別ブックに値貼り付けしたい!
投稿日時: 18/09/26 17:21:24
投稿者: maccc

特定の文字を含むシートを選択し、別ブックに値貼り付けするマクロを作成したいです。
以下のマクロはモーグの即効テクニックを参考にしたもので、
これを応用して、別ブックに値貼り付けする方法があればと思っております。
特定の文字を含むシートは数十シート以上ある想定です。
 
 
Sub Sample()
 
    Dim myWS As Worksheet
 
    For Each myWS In Worksheets
    ’日本という文字を含むシートを選択
        If myWS.Name Like "日本*" Then
            If ActiveSheet.Name Like "日本*" Then
                myWS.Select (False)
            Else
                myWS.Select
            End If
        End If
    Next
 
End Sub
 
 

回答
投稿日時: 18/09/26 20:10:25
投稿者: WinArrow
投稿者のウェブサイトに移動

応用といえば応用になるかもしれませんが、
殆どのコードが残らないでしょう。
 
まず、
マクロを作成ブックを想定する必要があります。
次に複写元ブック、複写先ブックを
明確にする必要があります。
 
このような観点でいうと
掲示のコードは、どのブックのシートなのか
全く分かりません。
 
特定の文字を含むシート名ということですね?
 
参考コード
AシートからBシートに全セルを「値複写」する方法
 
Dim myAddress As String
 
Sheets("B").cells.ClearContents
myAddRess = Sheets("A").UsedRage.Address
Sheets("B").Rage(myAddress).Value = Sheets("A").UsedRange.Value
 
 
 

回答
投稿日時: 18/09/26 20:15:18
投稿者: simple

こんばんは。
 
>別ブックに値貼り付けするマクロ
ということですが、
・別ブックの複数のシートにそれぞれシート単位に値貼り付けするのか、
それとも
・データのある部分だけを、別ブックの1つのシートにまとめて値貼り付けするのか、
どちらですか?
 
また、以下はこうしたら良いのでは、という提案です。
特定の文字を含むシートを同時に選択しているわけですが、
同時に選択しなくても、
ひとつずつ判断して条件にあったシートについて実行することを
繰り返したほうが簡単じゃないですか?
まとめて選択する趣旨が分かりませんが。

回答
投稿日時: 18/09/26 20:27:27
投稿者: WinArrow
投稿者のウェブサイトに移動

大事なことを忘れていました。
 
複写元ブックに存在する特定文字を含むシート名のシートを判断するコードは
>If myWS.Name Like "日本*" Then
で構いませんが、複写先シートが
>If ActiveSheet.Name Like "日本*" Then
このコードでよいのですか?
仮に、ActiveSheetが該当したとすると、
複写先は、常にActiveSheetになってしまいます。
 
推測ですが
複写元シート名と同名の複写先シート名のシートに複写するものと思いますが・・・・

投稿日時: 18/09/26 21:53:26
投稿者: maccc

イメージとしては、日本001、日本002、日本003 、米国001、米国002というシートの中から日本という文字を含むシートを別ブックには値貼り付けしたいです。
一つずつシートをコピーして貼り付ける方法でも、まとめて選択して貼り付ける方法でも、スムーズ作成出来るようであればどちらでも構わないです。

回答
投稿日時: 18/09/26 23:21:49
投稿者: WinArrow
投稿者のウェブサイトに移動

maccc さんの引用:
イメージとしては、日本001、日本002、日本003 、米国001、米国002というシートの中から日本という文字を含むシートを別ブックには値貼り付けしたいです。
一つずつシートをコピーして貼り付ける方法でも、まとめて選択して貼り付ける方法でも、スムーズ作成出来るようであればどちらでも構わないです。

 
再掲
コード作成依頼は、個々の掲示板では、禁止されています。
 
なお、シートを纏める方法(作業グループ)では、「値貼り付け」できません。
「値貼り付け」をする意図は?
 
 
複写先ブックは、既存のブックですか?
新しいブックですか?
 
 
 
 

回答
投稿日時: 18/09/27 22:23:41
投稿者: simple

元のシートの列幅などを含めて同じ幅のシートにする必要があるなら、
シートをコピーするのが簡単です。
そのうえで、元シートのUsedRangeを複写したシートに
「コピーして、値貼り付け」すればよいと思います。
(すでに提示されたように、値を直接セットすることもできますが)
 
すでに
(1)元のブックの各シートのシート名で判定して、
(2)すべてのシートの繰り返すこと
はできているわけですから、あとは、
(3)シートのコピー
(4)値貼り付け
をコードにすればよいわけです。
 
いずれもマクロ記録をとれば、コードが得られます。
どこに詰まっていますか?
単に足を踏み出していないだけではないですか?
勇気を持って踏み出しましょう。
 
もし詰まったところが出てきたら、
そこを具体的に(マクロ記録の結果を示しながら)
質問したらいかがですか?
そのほうが絶対にご自分の益になるものと思います。

投稿日時: 18/09/28 16:41:07
投稿者: maccc

記録マクロ等を使い、大幅に変更した結果、
 
Sub テスト()
    Dim Sh As Worksheet
    Dim ArrayShName() As String
    Dim i As Long
    
    '動的配列を初期化
    ReDim ArrayShName(0)
     
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.name Like "日本*" Then
            '配列の内容を保持したままシート名を配列に追加する
            ReDim Preserve ArrayShName(i)
            ArrayShName(i) = Sh.name
            i = i + 1
        End If
    Next Sh
     
    '指定した名前のシートがあるか確認
    If ArrayShName(0) = "" Then Exit Sub
     
    'シート名を格納した配列変数を指定してSelect
    Worksheets(ArrayShName).Select
    Worksheets(ArrayShName).Copy
     
    Worksheets.Select
     
    Sheets("日本001").Activate
    Cells.Select
    Range("A1").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
               
End Sub
 
上記のマクロで稼動することが出来ましたが、たとえば "日本"のところが"JP"にすると稼動しないということがあるのですが、エクセルの設定上の問題でしょうか。
 

回答
投稿日時: 18/09/28 17:51:21
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
上記のマクロで稼動することが出来ましたが、たとえば "日本"のところが"JP"にすると稼動しないということがあるのですが、エクセルの設定上の問題でしょうか。

シート名の中に「JP001」のような名前があるのでしょうか?
 
状況を説明して貰わないと何とも言えません。
 

回答
投稿日時: 18/09/29 02:18:57
投稿者: もこな2

なんかゴールから遠くなってるような・・・
 
とりあえずsimpleさんが、18/09/26 20:15:18 に
 (1)シートごとにコピーしたいのか(3シート → 3シート)
 (2)1つのシートに集約するようにしたいのか(3シート → 1シート)
どちらなのかという、非常に重要な確認をされてますが、そこの回答はどうなんでしょうか
 
いずれにせよ、対象シートを”選択する”ということは一旦忘れて、”処理する”という考え方にしたらどうでしょうか?

Sub テスト()
    Dim MySH As Worksheet
    
    For Each MySH In ThisWorkbook.Worksheets
        If MySH.Name Like "*日本*" Then
            MsgBox MySH.Name & "は対象シートです"
        End If
    Next

End Sub

ちなみに、18/09/28 16:41:07に投稿された、動いたとおっしゃっているそのコード、同一ブック内でのコピーになってませんか?
最初の方は別ブックと言っておられますが、同じブックで良いのです?
 
さらにいえば、ちょっと整理すると、こんな感じになりますけど
Sheets("日本001").Cells.Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues
これって、
(1)アクティブなブックの「日本001」シートの全セルを選択
(2)選択したセル範囲をコピー
(3)同じ場所(セル)にそのまま値貼り付け
ってなってますが、想定通りなのでしょうか?
 
ついでに、そのシートがなければもちろんエラーになるので、「JP001」なんてコードの中だけ変えたって意味がないのはわかりますよね?

回答
投稿日時: 18/09/29 09:36:30
投稿者: simple

ご苦労様でした。見事クリアーされましたね。
 
貴兄の処理のポイントは、
・複数シートを一括して新しいブックにコピー
・複数シートを同時に選択して値貼り付けする
ところでしょうか。
 
一般的に、シートをSelectするのは避けることとされていますが、
複数シートに対して一括して処理するケースでは、
Selectを積極的に利用する必要があり、「選択しない」の例外的なケースと言えると思います。
 
なお、私でしたらこんなコーディングにします。(下記 テスト1)
 
また、シートをひとつづつ処理することを想定していました。(下記 テスト2)
最初のシートとそれ以降で場合わけが必要ですが、
比較的単純な操作にはなると思います。
 
どちらでなければならないというものではないと思いますが、
参考になれば幸いです。
 

Sub テスト1()
    Dim sh As Worksheet
    Dim ArrayShName() As String
    Dim i As Long

    '動的配列を初期化
    ReDim ArrayShName(0)

    '「日本」で始まるシートのシート名を配列に保持
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name Like "日本*" Then
             ReDim Preserve ArrayShName(i)
            ArrayShName(i) = sh.Name
            i = i + 1
        End If
    Next sh

    '指定した名前のシートがあるか確認
    If ArrayShName(0) = "" Then Exit Sub

    '新しいブックにコピー
    Worksheets(ArrayShName).Copy

    '全シートを選択状態にして値貼り付け作業
    Worksheets.Select
    Cells.Copy
    Range("A1").PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").Select 'セル選択をCellsから単一セルに戻す
    
    '後始末
    Application.CutCopyMode = False
    Sheets(1).Select    '全シートを選択を解除
End Sub

 
Sub テスト2()
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim first As Boolean

    first = True '最初のシートコピーの時

    For Each sh In ThisWorkbook.Worksheets
        If sh.Name Like "日本*" Then
            If first = True Then
                sh.Copy
                Set wb = ActiveWorkbook
                first = False
            Else
                sh.Copy After:=wb.Sheets(wb.Worksheets.Count)
            End If

            'Copy先のシートがアクティブになっている(明示的に書いたほうがよいかも)
            Cells.Copy
            Range("A1").PasteSpecial Paste:=xlPasteValues, _
                        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("A1").Select   'セル選択をCellsから単一セルに戻す
        End If
    Next
    Application.CutCopyMode = False
End Sub

回答
投稿日時: 18/09/29 12:07:19
投稿者: もこな2

あぁ、なるほど。
 Worksheets([配列]).Copy
してるから、この段階でアクティブブックが切り替わってるんですね。失礼しました。
 
書式とかはコピーしてよいのかわからないですけど、こんなやり方もありますよってことで。
※個人的にActive〇〇への操作が嫌いなので、シート1枚だけのブックを作ってから、最後に要らないシートを削除しています。

Sub Sample()
    Dim MySH As Worksheet
    
    With Workbooks.Add(xlWBATWorksheet)
        
        '日本という文字をシート名に含む場合だけ処理
        For Each MySH In ThisWorkbook.Worksheets
            If MySH.Name Like "*日本*" Then
                With Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
                    .Name = MySH.Name
                    .Range(MySH.UsedRange.Address).Value = MySH.UsedRange.Value
                End With
            End If
        Next MySH
        
        'ブック生成時の余分なシートを削除
        Application.DisplayAlerts = False
        If .Worksheets.Count > 1 Then .Worksheets(1).Delete
        Application.DisplayAlerts = True
        
    End With
End Sub

投稿日時: 18/10/01 18:51:08
投稿者: maccc

ありがとうございます。
 
参考にさせて頂きました。