Excel VBA質問箱 IV

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

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


40827 / 76732 ←次へ | 前へ→

【40995】Re:別ファイルへのコピー&ペーストの仕方
回答  Kein  - 06/7/27(木) 15:05 -

引用なし
パスワード
   Sub MyWorkbooks()
  Dim sFolderName As String, sFileName As String
  Dim WB As Workbook, Sh As Worksheet
  Dim i As Integer
  
  sFolderName = ThisWorkbook.Path & "\DATA\"
  sFileName = Dir$(sFolderName & "時間外*.xls"
  Set Sh = Workbooks("表題.xls").Worksheets(1)
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
  End With
  Do Until sFileName = ""
    Set WB = Workbooks.Open(sFolderName & sFileName)
    For i = WB.Worksheets.Count To 1 Step -1
     With WB.Worksheets(i)
       If IsEmpty(.Range("A5").Value) Or _
       .Name = "サンプル" then
        .Delete
       Else 
        .Range("A5", .Range("A65536").End(xlUp)) _
        .Resize(, 20).Copy Sh.Range("A65536") _
        .End(xlUp).Offset(1)
       End If
     End With
    Next i
    WB.Close True: Set WB = Nothing
    sFileName = Dir$()
  Loop
  With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
  End With
  Set Sh = Nothing: MsgBox "処理を終了しました", 64
End Sub

で、どうでしょーか ?

1 hits

【40993】別ファイルへのコピー&ペーストの仕方 ゆき太 06/7/27(木) 14:38 質問
【40995】Re:別ファイルへのコピー&ペーストの仕方 Kein 06/7/27(木) 15:05 回答
【41000】Re:別ファイルへのコピー&ペーストの仕方 ゆき太 06/7/27(木) 15:42 お礼

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