こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

VBA 指定した範囲のデータ抽出

Excel VBA初心者の質問です。
以下の作業を行うため、30個のファイルをVBAを活用して処理したいのですが、
詳しい方おられましたらコードの書き方をご教授お願いいたします。
ネットで参考になるコードをいくつか調べたのですがギブアップでした。

1.フォルダA内の一番上のファイルから順番に処理(ファイル名:1101,1102,1103・・・1130)
※ファイルのシート名はそれぞれ「"データ"番号」となっている。
2.「"データ"1101」シートのデータ範囲(A1:AT1000)、(A7000::AT8000)の2つの範囲をコピー
3.新しいBookのSheet1に上詰めで貼り付け
4.次ファイルの「"データ"1102」シートに2の処理を行う
5.新しいBookのSheet2に上詰めで貼り付け

以上の処理を1130のファイルまで繰り返し行います。

投稿日時 - 2016-11-11 15:27:37

QNo.9254330

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

ANo.1

こんにちは
Sub test()
  Dim i As Long
  Dim k As Long
  Dim p As String
  Dim b As Workbook
  Dim n As Workbook
  Dim s As Worksheet
  p = "C:\A\"
  Set n = Workbooks.Add
  Application.ScreenUpdating = False
  On Error Resume Next
  For i = 1101 To 1130
    Set b = Workbooks.Open(p & i & ".xlsx", , True)
    If b Is Nothing Then
      MsgBox p & i & ".xlsx 無し"
    Else
      k = k + 1
      Set s = n.Worksheets("Sheet" & k)
      If s Is Nothing Then
        Set s = n.Worksheets.Add
        s.Name = "Sheet" & k
      End If
      b.Worksheets("データ" & i).Range("A1:AT1000").Copy s.Range("A1")
      b.Worksheets("データ" & i).Range("A7000::AT8000").Copy _
        s.Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
    b.Close
    Set b = Nothing
  Next
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub
こういう事でしょうか?

投稿日時 - 2016-11-11 15:53:42

あなたにオススメの質問