Excel VBA質問箱 IV

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

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


38314 / 76732 ←次へ | 前へ→

【43557】Re:シートのコピーについて
発言  Jaka  - 06/10/19(木) 11:02 -

引用なし
パスワード
   検証してないので、動かなかったらごめんなさい。

Sub Test3()
  Dim myf As Variant
  Dim MyB As Workbook, OpWB As Workbook, WS As Worksheet
  Dim i As Integer, bcnt As Integer, SCnt As Integer
  Dim fname As Worksheet

  With Application
   myf = .GetOpenFilename("エクセルブック(*.xls),*.xls", , , , True)
   If VarType(myf) = 11 Then Exit Sub
  End With
  Ct = 0
  For Each st In myf
    Set OpWB = Workbooks.Open(st)
    For Each WS In OpWB.Sheets
      If WS.Name Like "内訳書*" Then
       If MyB.Sheets.Count <= Ct Then
         MyB.Worksheets.Add after:=Worksheets(MyB.Worksheets.Count)
       End If
       Ct = Ct + 1
       WS.UsedRange.Copy MyB.Sheets(Ct).Range(WS.UsedRange.Address)
       DoEvents
      End If
    Next
    OpWB.Close (False)
    Set OpWB = Nothing
  Next
 
  With Application
   .ScreenUpdating = True
  End With
 
  Set MyB = Nothing
End Sub
2 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 発言

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