ここから本文です

Excel vbaのエラー回避 excel vbaで あるフィルダにある複数bookから特定シー...

アバター

ID非公開さん

2017/1/613:36:40

Excel vbaのエラー回避


excel vbaで あるフィルダにある複数bookから特定シートを抽出する

ものをつくり運用してますが、最初にフォルダを指定して実行するとファイル名が長かったり、禁止文字が含まれている場合、エラーで
とまってしまいます。

現状は、作業に入る前にファイル名をフリーソフトで一括変換(連番)にし
ています。

この作業が煩わしいのでエラーを回避するコードをおしえていただけないでしょうか?

現状以下のコードです ※素人なのでめちゃくちゃなコードでご了承ください。


Sub sheetcopy()

Dim 指定フォルダ 'As FileDialog
Dim フォルダのパス 'As String
Dim ファイル名 'As String
Const コピー元シート番号 = "VOD用明細書" '抽出sheet名
Dim ws

Application.EnableEvents = False

Set 指定フォルダ = Application.FileDialog(msoFileDialogFolderPicker)
If 指定フォルダ.Show = 0 Then
Exit Sub
End If
フォルダのパス = 指定フォルダ.SelectedItems(1)

ファイル名 = Dir(フォルダのパス & "\*.xls*")
If ファイル名 = "" Then
MsgBox "このフォルダ内にはEXCELファイルがありません。" _
& vbCrLf & "マクロを終了します。"
Exit Sub
End If


With ThisWorkbook
Do While ファイル名 <> ""
Workbooks.Open (フォルダのパス & "\" & ファイル名), UpdateLinks:=0 'ファイルOPEN
Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count)) '新規sheet追加
Workbooks(ファイル名).Worksheets(コピー元シート番号).AutoFilterMode = False 'オートフィルタ解除


Workbooks(ファイル名).Worksheets(コピー元シート番号).Cells.copy 'コピー

ws.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths '列幅コピー
ws.Range("A1").PasteSpecial Paste:=xlValues '値コピー
ws.Range("A1").PasteSpecial Paste:=xlFormats '書式コピー
ws.Range("I441") = "=SUBTOTAL(9,E10:E439)" '合計にSUBTOTAL関数を入力
ws.Range("A9").AutoFilter 'Field:=7, Criteria1:="○○○" 'オートフィルタを○○で設定
ws.Name = ファイル名 'シート名をファイル名に変更

Application.CutCopyMode = False 'クリップボードダイアログ回避

Workbooks(ファイル名).Close savechanges:=False

ファイル名 = Dir()
Loop
End With

Application.EnableEvents = True

End Sub

閲覧数:
89
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

h_tana_0530さん

2017/1/619:11:47

こんばんは。

コードを拝見する限り、新規に作成したシート名を元データのファイル名で置き換える所でエラーが出ると思われます。
ならば、元ファイルのファイル名を書き換えなくても、シート名を書き換える所で連番を付けてしまえばよいと思います。
例えば

Dim Cnt As Long ' 変数追加

With ThisWorkbook
Cnt = 1 '変数初期化追加
Do While ファイル名 <> ""

ws.Name = "Book" & Format(Cnt , "000")

ファイル名 = Dir()
Cnt = Cnt + 1 '変数インクリメント
Loop

といった具合です。

アバター

質問した人からのコメント

2017/1/6 19:57:23

無事解決できました。ありがとうございました!

あわせて知りたい

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる