Map aanmaken, bestand kopieren en verwijderen

[BasSchuring]

Beste mensen

Ik heb een loop:

Sub hsv2()

Dim wbCSV   As Workbook
Dim wsMstr  As Worksheet:   Set wsMstr = ThisWorkbook.Sheets("Export shop")
Dim fPath   As String:      fPath = "C:\Users\b.schuring\Desktop\shop csv\"
Dim fCSV    As String
Dim c As Range, firstaddress As String, j As Long, n As Long

If MsgBox("'Leeg Sheet Export shop voor inlezen CSV?", vbYesNo, "Clear?") _
    = vbYes Then wsMstr.UsedRange.Clear

Application.ScreenUpdating = True

fCSV = Dir(fPath & "*.csv")

Do While Len(fCSV) > 0
      
        Set wbCSV = Workbooks.Open(fPath & fCSV)
        ActiveSheet.UsedRange.Copy wsMstr.Range("A1")
        wbCSV.Close False

        With Sheets("export shop")
        Call hsv
        End With
        
fCSV = Dir

Loop

Application.ScreenUpdating = True

Sheets("Filter").Select
Cells.Select
Selection.AutoFilter
Selection.AutoFilter

Sheets("export shop").UsedRange.Clear

End Sub
[CODE]

[/CODE]


En in de loop wordt de volgende macro aangeroepen:

Sub hsv()
Dim c As Range, firstaddress As String, j As Long, n As Long
With Sheets("export shop")
With .Range("a1:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
ReDim arr(.Rows.Count, 9)
   Set c = .Find("product", , , xlPart)
 If Not c Is Nothing Then
     firstaddress = c.Address
 Do
  If UCase(Split(c)(0)) = "PRODUCT" Then
      For j = 0 To 8
  arr(n, j) = c.Offset(j)
      Next j
          n = n + 1
           End If
      Set c = .FindNext(c)
  Loop While Not c Is Nothing And c.Address <> firstaddress
        End If
      End With
    End With
  With Sheets("gesorteerd")
     .Cells(1).CurrentRegion.ClearContents
     .Cells(1).Resize(n, 9) = arr
     .Columns(1).Resize(, 9).AutoFit
End With

Sheets("Filter").Select
Selection.AutoFilter

Application.ScreenUpdating = False
Application.EnableEvents = False
With Sheets("Filter")
Sheets("orderoverzicht").Cells(1).CurrentRegion.Offset(1).Copy
    .Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
    With .Cells(1).CurrentRegion
       .Value = .Value
       .Offset(1).Sort .Range("D1")
       .Columns(1).NumberFormat = "general"
       .Columns(4).NumberFormat = "dd-mm-yyyy"
          Application.Goto .Cells(1)

      Sheets("Filter").Select
    Cells.Select
    Selection.AutoFilter
       End With
       
     Sheets("werkbon").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1
 Sheets("pakbon").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1 'Sheets("pakbon").Range("L25")
     
Sheets("Filter").Select
End With

End Sub

Met dank aan HSV

Maar nu de vraag. Ik zou graag ergens de code tussen plakken dat zodra er een bestand wordt geopend uit de map: shop csv er op een andere schijf een map wordt aangemaakt met als naar de bestandsnaam van de CSV. Tevens moet het bestand hierin worden gekopieerd en worden verwijderd uit de map: shop csv.

Ik heb her en der al wat codes gevonden maar ik krijg het niet werkend, ik hoop dat er een geniaal iemand is die mij hiermee kan helpen.

alvast bedankt!

Bas