Excel VBA質問箱 IV

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

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


5080 / 76732 ←次へ | 前へ→

【77265】Re:シートをまとめる
発言  β  - 15/6/27(土) 15:09 -

引用なし
パスワード
   ▼エクセル勉強中 さん:

コピー先ブックの状態のみならず、コピー元ブックの状態、
特にそこにある式がコピペでOKなものなのかどうか不透明な部分が少なくないのですが
とりあえず。

DeskTopにあるエクセルブックを読みこみ、各ブックの最初のシートのデータを
マクロブックの最初のシートにコピペします。

Sub Test集約()
  Dim fPath As String
  Dim fName As String
  Dim fSh As Worksheet
  Dim tSh As Worksheet
  Dim z As Long
  
  Application.ScreenUpdating = False
  
  Set tSh = ThisWorkbook.Sheets(1)
  fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test\"
  
  fName = Dir(fPath & "*.xls*")
  
  Do While fName <> ""
    If fName <> ThisWorkbook.Name Then '念のため
      Set fSh = Workbooks.Open(fPath & fName).Sheets(1)
      z = fSh.Columns("C").Find(What:="*", LookAt:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious, After:=fSh.Range("C" & Rows.Count)).Row
      If z > 17 Then
        Range("A17:J" & z).Copy tSh.Range("C" & Rows.Count).End(xlUp).Offset(1).Offset(, -2)
      End If
      fSh.Parent.Close False
    End If
    fName = Dir()
  Loop
    
End Sub
437 hits

【77258】シートをまとめる エクセル勉強中 15/6/27(土) 1:02 質問[未読]
【77259】Re:シートをまとめる β 15/6/27(土) 5:52 発言[未読]
【77260】Re:シートをまとめる kanabun 15/6/27(土) 11:26 発言[未読]
【77261】Re:シートをまとめる エクセル勉強中 15/6/27(土) 12:15 発言[未読]
【77262】Re:シートをまとめる kanabun 15/6/27(土) 14:07 発言[未読]
【77264】Re:シートをまとめる kanabun 15/6/27(土) 14:29 発言[未読]
【77266】Re:シートをまとめる エクセル勉強中 15/6/27(土) 15:21 発言[未読]
【77267】Re:シートをまとめる kanabun 15/6/27(土) 15:30 発言[未読]
【77265】Re:シートをまとめる β 15/6/27(土) 15:09 発言[未読]
【77263】Re:シートをまとめる kanabun 15/6/27(土) 14:22 発言[未読]

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