[[20120510150633]]　『フォルダ内のxlsファイル名/シート名/特定セルの氏x（ういお）　ページの最後に飛ぶ

『フォルダ内のxlsファイル名/シート名/特定セルの取得転記』（ういお）

 Sub シート名一覧()
 Dim myObj As Object
 Dim myFileName As String
 Dim myDir As String
 Dim mySheet As Worksheet

 Application.ScreenUpdating = False

 With ThisWorkbook.ActiveSheet

    Set myObj = CreateObject("Shell.Application"). _
                BrowseForFolder(0, "フォルダを選択してください", 0)

    If myObj Is Nothing Then Exit Sub

    myDir = myObj.Items.Item.Path & "\"

    myFileName = Dir(myDir & "*.xls", vbHidden + vbSystem)

    Do
        Workbooks.Open myDir & myFileName

        For Each mySheet In ActiveWorkbook.Worksheets
            .Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = myFileName
            .Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = mySheet.Name
　　　　　　①
        Next mySheet

        Workbooks(myFileName).Close False
        myFileName = Dir()

    Loop Until myFileName = vbNullString

 Application.ScreenUpdating = True
 End With

 End Sub

 上記は特定のフォルダ内にある各ファイル名/シート名を取得し別のファイルに転記するマクロです。
 （自力では作れなかったのでネットで調べて拝借させて頂きました…）

 そして上記にシート毎のA1セルの値も取得転記するよう構文を追加したいのですが、単純に
  .Cells(Rows.Count, 3).End(xlUp).Offset(1).Value = mySheet.Range("A1") 　と①の部分に足しても、
 A1セルが空セルのシートがあった場合に空行を詰めてしまい正しく転記させる事ができませんでした。

 A1が空セルの場合は"無し"と転記させる等にすれば上手くできそうですが…（それも自力でできず…）
 解決の方法をご教授願えますでしょうか。よろしくお願い致します。

 「無し」の表示は特に要らないのですよね。。。？

 こんな感じでA列（FileNameを入れていく列）の最後のセルを基準にしてみるとどうですか？
        For Each mySheet In ActiveWorkbook.Worksheets
            With .Cells(Rows.Count, 1).End(xlUp)
                .Offset(1, 0).Value = myFileName
                .Offset(1, 1).Value = mySheet.Name
                .Offset(1, 2).Value = mySheet.Range("A1").Value
            End With
        Next mySheet

 (HANA)

 HANA様
 無の表示は要りません！
 希望通りとなりました。ありがとうございました。
 (ういお)

コメント返信：

[ 一覧(最新更新順) ]

[[20120510150633]] 『フォルダ内のxlsファイル名/シート名/特定セルの氏x（ういお） ページの最後に飛ぶ

[[20120510150633]]　『フォルダ内のxlsファイル名/シート名/特定セルの氏x（ういお）　ページの最後に飛ぶ