マンガでよめる痔のこと・薬のこと

Excelvbaで下記動作をさせたいです。
①「作成」というブック名のExcelファイル(
xlsx)があります。作成のExcelファイルは原紙というシートのみあります。それと同一フォルダー内に適当な名前が付いたExcelファイル(xlsx)がいくつかあります。
②作成を開きマクロを実行すると、適当な名前が付いたExcelファイルの一番左側のシートが作成のExcelファイルへ移動します。移動した後のシート名は1、2、3、4、5、6・・・と連番とします。シート構成は、原紙、1・2・3というようになります。

質問者からの補足コメント

  • ①「適当な名前が付いたExcelファイル(xlsx)」の張付け順番は気にしないで同じフォルダの物を全て張付ければ良いという事でしょうか?

    →同じフォルダー内のExcelファイル全てで順番は気にしません。※作成Excelファイルに移動するファイルは一番左のみでお願いします。
    ② マクロを書き込んでいるExcelファイル(xlsm)ファイルも同じフォルダに有るという事で良いのでしょうか?

    →xlsmも同じフォルダー内にあります。

      補足日時:2020/01/14 21:06
  • マクロを書き込んでいるExcelファイル(xlsm)と同じフォルダーにxlsmとxlsxが二種類あった場合も同じ動作が行くようにできますか。

      補足日時:2020/01/15 12:19

A 回答 (3件)

こんばんは!



一例です。
「作成」ブックの標準モジュールにしてください。

Sub Sample1()
 Dim myPath As String, fN As String
 Dim cnt As Long
 Dim wB As Workbook, wS As Worksheet
  myPath = ThisWorkbook.Path & "\"
  fN = Dir(myPath & "*.xlsx")

  Application.ScreenUpdating = False
   Do Until fN = ""
    Workbooks.Open (myPath & fN)
     Set wB = ActiveWorkbook
     cnt = cnt + 1
     With ThisWorkbook
      .Worksheets.Add after:=Worksheets(cnt)
      Set wS = .Worksheets(cnt + 1)
       wS.Name = cnt
       wB.Worksheets(1).Cells.Copy wS.Range("A1")
        Application.DisplayAlerts = False
         wB.Close
        Application.DisplayAlerts = True
       fN = Dir()
     End With
   Loop
  Application.ScreenUpdating = True
   MsgBox "完了"
End Sub

※ 未検証なので、不具合が出たらごめんなさい。m(_ _)m
    • good
    • 0

以下のような物はいかがでしょうか?


※「作成.xlsx」が閉じている状態で実行して下さい。
※ 適当な名前の、Excelファイル(xlsm)に書き込んで実行して下さい。

Sub Sample()

Const 作成ファイル名 As String = "作成.xlsx"
Dim パス名 As String
Dim シート番号 As Long
Dim ファイル名 As String
Dim 処理済 As Boolean

 パス名 = ThisWorkbook.Path & "\"
 Workbooks.Open Filename:=パス名 & 作成ファイル名
 Application.DisplayAlerts = False
 Do Until Workbooks(作成ファイル名).Sheets.Count = 1
  Sheets(2).Delete
 Loop
 Application.DisplayAlerts = True
 ファイル名 = Dir(パス名 & "*.xlsx")
 Do While ファイル名 <> ""
  If ファイル名 <> 作成ファイル名 Then
   Workbooks.Open Filename:=パス名 & ファイル名
   シート番号 = シート番号 + 1
   Sheets(1).Copy After:=Workbooks(作成ファイル名).Sheets(シート番号)
   ActiveSheet.Name = シート番号
   Windows(ファイル名).Close
   ファイル名 = Dir()
  Else
   If 処理済 Then
    Exit Sub
   Else
    処理済 = True
   End If
  End If
 Loop

End Sub
    • good
    • 0

①「適当な名前が付いたExcelファイル(xlsx)」の張付け順番は気にしないで同じフォルダの物を全て張付ければ良いという事でしょうか?


② マクロを書き込んでいるExcelファイル(xlsm)ファイルも同じフォルダに有るという事で良いのでしょうか?
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報