下のコードをブック・シート名指定なしでフォルダから転記したいです。 詳しくは下記URLに記載。 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12159449297 ___________________________________________________ Sub データ取込メイン() Dim sheetobj As Worksheet Dim FolderPath As String Dim 年月 As String Dim ret As Integer '(1)---------------------------------------- '集計表シートクリア プロシージャの呼び出し Call 集計表シートクリア '---------------------------------------- '(2)---------------------------------------- 'フォルダPathと年月の取得 Set sheetobj = ThisWorkbook.Worksheets("メイン画面") With sheetobj FolderPath = .Cells(2, 3) 年月 = .Cells(4, 3) End With '(3)---------------------------------------- 'フォルダPathと年月が入力されているか確認 If FolderPath = "" Then ret = MsgBox("フォルダPathを入力してください", vbCritical) Exit Sub End If If 年月 = "" Then ret = MsgBox("年月を入力してください", vbCritical) Exit Sub End If '(4)---------------------------------------- 'ファイルOpen プロシージャの呼び出し Call ファイルOpen(FolderPath, 年月) '---------------------------------------- '(5)---------------------------------------- '集計表シートを表示する ThisWorkbook.Worksheets("TE集計表").Activate End Sub Sub 集計表シートクリア() Dim salessheet As Worksheet Set salessheet = ThisWorkbook.Worksheets("TE集計表") With salessheet '(1)---------------------------------------- 'すべてのセルの値を消す .Cells.ClearContents '(2)---------------------------------------- '1行目にタイトルを記入 .Cells(1, 1) = "社員コード" .Cells(1, 2) = "氏名" .Cells(1, 3) = "日付" .Cells(1, 4) = "出発" .Cells(1, 5) = "到着".Cells(1, 6) = "種別" .Cells(1, 7) = "目的" Cells(1, 8) = "補助科目".Cells(1, 9) = "負担先" .Cells(1, 10) = "往復片道".Cells(1, 11) = "金額" .Cells(1, 12) = "小計" '---------------------------------------- End With End Sub Sub ファイルOpen(FolderPath As String, 年月 As String) Dim bookobj As Workbook Dim sheetobj As Worksheet Dim i As Integer Dim FilePath As String Dim 氏名 As String Dim 社員コード As String Set sheetobj = ThisWorkbook.Worksheets("社員マスタ") With sheetobj '(1)---------------------------------------- '社員コードと氏名を順番に取得 For i = 2 To LastRow(sheetobj, 1) 社員コード = .Cells(i, 1) 氏名 = .Cells(i, 2) '(2)---------------------------------------- 'FolderPathにファイル名を連結 FilePath = FolderPath & "\" & 年月 & 氏名 & ".xlsx" '(3)---------------------------------------- 'ワークブックを開いて、bookobjに代入 Set bookobj = Workbooks.Open(FilePath) '(4)---------------------------------------- 'データ転記プロシージャに販売実績シートと社員の氏名を渡す Call データ転記(bookobj.Worksheets(年月), 社員コード, 氏名) '(5)---------------------------------------- '社員のワークブックを閉じます。 bookobj.Close Next i End With End Sub Sub データ転記(datasheet As Worksheet, 社員コード As String, 氏名 As String) Dim salessheet As Worksheet Dim 基準行 As Long Dim 日付 As Date Dim 出発 As String Dim 到着 As String Dim 種別 As String Dim 目的 As String Dim 補助科目 As String Dim 負担先 As StringDim 往復片道 As String Dim 金額 As Long Dim 小計 As Long '(1)---------------------------------------- Set salessheet = ThisWorkbook.Worksheets("TE集計表") 基準行 = LastRow(salessheet, 1) '(2)---------------------------------------- 'データシートから値を取得 For i = 9 To LastRow(datasheet, 1) '(3)---------------------------------------- 'データシートから値を取得 日付 = datasheet.Cells(i, 1) 出発 = datasheet.Cells(i, 2)到着 = datasheet.Cells(i, 4) 種別 = datasheet.Cells(i, 5) 目的 = datasheet.Cells(i, 6) 補助科目 = datasheet.Cells(i, 7) 負担先 = datasheet.Cells(i, 8) 往復片道 = datasheet.Cells(i, 9) 金額 = datasheet.Cells(i, 10) 小計 = datasheet.Cells(i, 11) '(4)---------------------------------------- '値を転記 salessheet.Cells(基準行 + i - 8, 1) = 社員コード salessheet.Cells(基準行 + i - 8, 2) = 氏名 salessheet.Cells(基準行 + i - 8, 3) = 日付 salessheet.Cells(基準行 + i - 8, 4) = 出発 salessheet.Cells(基準行 + i - 8, 5) = 到着 salessheet.Cells(基準行 + i - 8, 6) = 種別 salessheet.Cells(基準行 + i - 8, 7) = 目的 salessheet.Cells(基準行 + i - 8, 8) = 補助科目 salessheet.Cells(基準行 + i - 8, 9) = 負担先 salessheet.Cells(基準行 + i - 8, 10) = 往復片道 salessheet.Cells(基準行 + i - 8, 11) = 金額 salessheet.Cells(基準行 + i - 8, 12) = 小計 '------------------------------------
↧