Sub Yasser()
Dim FLDR As Object
Dim LR As Long
Dim fldrname As String
Dim fldrpath As String
On Error Resume Next
LR = Cells(Rows.Count, 2).End(xlUp).Row
For X = 2 To LR
Set FLDR = CreateObject("scripting.filesystemobject")
fldrname = Range("B" & X).Text & ""
fldrname2 = Range("A" & X).Text & ".BMP"
fldrpath = ThisWorkbook.Path & "" & fldrname
If Not FLDR.folderexists(fldrpath) Then
FLDR.createfolder (fldrpath)
End If
FLDR.MoveFile Source:=ThisWorkbook.Path & "" & fldrname2, Destination:=fldrpath
Next
MsgBox "تم معالجة البيانات"
End Sub