| |
下記コードでループせず1回で終了してしまいます。
何回見直してもわかりません、ご教授お願いできませんでしょうか。
よろしくお願いします。
対象のフォルダには3つ以上の.xlsxファイルがあります。
Sub 販売営業インセンティブへの転記()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fp As String
fp = ThisWorkbook.path
Dim 行先 As String
行先 = "C:\Users\5058\Desktop\販売営業インセンティブ"
Dim 対象 As String
対象 = Dir(fp & "\" & "インセンティブ" & "\" & "*.xlsx")
Do Until 対象 = ""
Dim 店番 As String
店番 = Left(対象, 3) & "*"
Dim 行先フォルダ As String
行先フォルダ = Dir(行先 & "\" & 店番, vbDirectory)
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile fp & "\" & "インセンティブ" & "\" & 対象, 行先 & "\" & 行先フォルダ & "\"
対象 = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 23/3/1(水) 20:08 -
