Excel VBA質問箱 IV

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

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


40829 / 76732 ←次へ | 前へ→

【40993】別ファイルへのコピー&ペーストの仕方
質問  ゆき太  - 06/7/27(木) 14:38 -

引用なし
パスワード
   VBA初心者で知識が乏しく、色々なコードを参考に作っているですが
行き詰ってしまいました。
お力をお貸しいただけたら、大変ありがたいです。

フォルダー(DATA)の中に入っている、
ファイル名「時間外」で始まるすべてのファイルに処理をします。
ファイルの中身はシートで分かれていて、すべて同じフォーマットの表
が入っています。

ファイルごとに入っている表のデータを別ファイル「表題.xls」に
貼り付け、1つの表のデータにしたいと思っています。
(下にどんどん貼り付けていく)
その際、シート名「サンプル」とA5にデータのないシートに関しては
シートを削除しています。


Sub MyWorkbooks()
  
  Dim sFolderName As String
  Dim sFileName As String
  
  '対象フォルダの設定
  sFolderName = ThisWorkbook.Path & "\DATA\"

  '"時間外"で始まるファイル名を取得
  sFileName = Dir$(sFolderName & "時間外*.xls")

  'ファイル名の列挙が終わるまで実行します
  Do Until sFileName = ""

  'ブックを開きます
  Workbooks.Open sFolderName & sFileName

   'ブックに対する処理
  Proc
  
  '次のファイル名を取得
  sFileName = Dir$()
 Loop

End Sub

'ブックに対する処理
Sub Proc()
  Dim intLoop As Integer
  Dim LastRow As Integer
  Dim myfile As String
  Dim HLastRow As Integer
 
  myfile = ActiveWorkbook.Name
  For intLoop = 1 To Worksheets.Count
    If Worksheets(intLoop).Range("A5").Value = "" _
      Or Worksheets(intLoop).Name = "サンプル" Then
    If Worksheets.Count > 1 Then Worksheets(intLoop).Delete
    Else
      Range("A65536").End(xlUp).Select
      LastRow = ActiveCell.Row
      Range("A5:T" & LastRow).Copy
      Windows("表題.xls").Activate
      Cells(65536, 1).End(xlUp).Offset(1).Select
      HLastRow = ActiveCell.Row
      Range("A" & HLastRow).Select
      ActiveSheet.Paste
      Workbooks("myfile.xls").Activate
    End If
  Next intLoop
End Sub

「表題.xls」に貼り付けるまでは、なんとか動いたのですが
「表題.xls」からコピー元のファイルに戻って、
次のシートも同じ処理をさせるところが、分かりません。
どうか、ご指導お願い致します。
0 hits

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

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