Sub Macro1()
'転記元ファイルの取得用変数
Const FILE_PATH = "C:\Tera\XLS"
Dim sFileName As String
'転記元のシートの変数
Dim copyWb As Excel.WorkBook
Dim copyWs As Excel.Worksheet
'転記先のシートの変数
Dim pasteWs As Excel.Worksheet
'出力行
Dim iPasteRow As Integer
'転記先のシートを取得
'マクロが書かれているブックの、アクティブなシート
Set pasteWs = Excel.ThisWorkbook.ActiveSheet
'出力する空白セルの指定
Dim pasteCell As Excel.Range
Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1)
'出力行を取得(先頭行)
iPasteRow = pasteCell.Row
'対象フォルダからExcelファイル名を取得
sFileName = Dir(FILE_PATH & "*.xls*")
If sFileName = "" Then
'フォルダにExcelファイルが1つもない場合は処理終了
Exit Sub
End If
'対象フォルダ内のすべてのExcelファイルをループ処理
Do
'転記元ブックをオープン
Set copyWb = Workbooks.Open Filename:=FILE_PATH & "\" & sFileName
'転記元シートを取得
Set copyWs = copyWb.WorkSheets(0) '先頭シート ※シート名が固定ならシート名指定でも可。
'除外するものがあればここで条件を指定して転記処理に入れない
If TRUE = TRUE Then
'除外するもの以外は転記処理
'~省略~
'~省略~
'転記したら出力行を1行進める
iPasteRow = iPasteRow + 1
End If
'転記元ブックを閉じる
copyWb.Close SaveChanges:=False
'次のファイル名を取得
sFileName = Dir
Loop Until sFileName = "" 'ファイル名が取得できなくなるまで繰り返す
End Sub
度々の質問を、誠に恐縮です。
懲りず、何卒アドバイスをいただけますと幸甚です。
「出力する空白セルの指定」に、いきづまってしまいました。
困っている状況は、
1つ目の転記元のデータがうまく転記先のテーブル(A2-I17。厳密には、D列だけ値が17行目まで転記され、その他は2行目以外転記元にデータがなかったので空白セルになっています。)
にはいりましたが、
2つ目の転記元のデータをペースト実行されると、1つ目のデータの2行目から上書きされてしまいます。(A3-I6まで2つめの転記元データが入り、2行目と7行目以降は、1個目のデータが残っている状態。)
最大数の行にデータが入るD列の一番最下セルを探し、offset(1)でその下の行から次の転記元データを入れると理解しておりまして、
'出力する空白セルの指定
Dim pasteCell As Excel.Range
Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).Offset(1)
を
Dim pasteCell As Excel.Range
Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlLeft).Offset(1)
や
Dim pasteCell As Excel.Range
Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).End(xlLeft).Offset(1)
と、試してみたりしてみましたが、
そうすると実行ができずにエラー表示が出てデバッグの画面になってしまいます。
何卒またお力添えいただけると幸いです。
よろしくお願いいたします。
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
退会済みユーザー
2017/12/27 06:16
退会済みユーザー
2018/01/09 06:27
2018/01/09 07:09
退会済みユーザー
2018/01/10 01:10
2018/01/10 02:16 編集
退会済みユーザー
2018/01/10 06:56
退会済みユーザー
2018/01/12 02:57
退会済みユーザー
2018/01/12 04:11
2018/01/12 05:10
退会済みユーザー
2018/01/12 05:44
2018/01/12 08:11
退会済みユーザー
2018/01/12 08:29