Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


38319 / 76732 ←次へ | 前へ→

【43551】Re:シートのコピーについて
回答  へっぽこ  - 06/10/19(木) 10:28 -

引用なし
パスワード
   こんにちは。

Sub Test3()
  Dim myf As Variant
  Dim MyB As Workbook
  Dim i As Integer, bcnt As Integer, SCnt As Integer
  Dim sNo As Integer '対象シート番号
  Dim fname As Worksheet

  With Application
   myf = .GetOpenFilename("エクセルブック(*.xls),*.xls", , , , True)
   If VarType(myf) = 11 Then Exit Sub
   bcnt = UBound(myf)
   SCnt = .SheetsInNewWorkbook
   .SheetsInNewWorkbook = bcnt
   .ScreenUpdating = False
  End With
  Set MyB = Workbooks.Add
  For i = 1 To bcnt
   Workbooks.Open myf(i)
   'いま開いたブックのシートを見て回る
   For sNo = 1 To Worksheets.Count
    'Like演算子で比較
    If Worksheets(sNo).Name Like "内訳書*" Then
      Exit For
    End If
   Next
   If sNo <= Worksheets.Count Then
    '見つかった場合
    ActiveWorkbook.Worksheets(sNo) _
      .Cells.Copy MyB.Worksheets(i).Range("A1")
   End If
   ActiveWorkbook.Close False
  Next i
  With Application
   .SheetsInNewWorkbook = SCnt
   .ScreenUpdating = True
  End With
 
  Set MyB = Nothing
End Sub

こんな感じでどうでしょうか?

0 hits

【43548】シートのコピーについて りこ 06/10/19(木) 10:04 質問
【43551】Re:シートのコピーについて へっぽこ 06/10/19(木) 10:28 回答
【43553】Re:シートのコピーについて りこ 06/10/19(木) 10:35 お礼
【43557】Re:シートのコピーについて Jaka 06/10/19(木) 11:02 発言

38319 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free