Opslaan op USB-Stick

[TonyLa]

Beste helpers,
Ik heb een macro ( zie onderstaand) waarin ik een kopie van een werkblad (printversie) wil opslaan op een USB-stick.
De werkmap staat op de stick.
Ik wil deze kopie opslaan op dezelfde USB stick als de werkmap, zonder de drive letter te gebruiken, omdat wanneer ik de stick in een andere pc duw, de drive letter op dat moment kan wijzigen.
In de macro geef ik momenteel dus de drive letter mee, maar daar wil ik van af.

Sub Uitslag_Opslaan()
'
' Uitslag_Opslaan Macro
'
    Application.ScreenUpdating = False
'
    Sheets("Printversie").Select
    Sheets("Printversie").Copy
    Range("A1:AB51").Select
    
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
                 
    Range("B1:AB51").Select
    Selection.Copy
    Range("A1").Select
                 
    ActiveWorkbook.SaveCopyAs "M:" & Range("B20") & (".xlsx")
        ActiveWorkbook.Close Savechanges:=False
    
    Windows("Scorebord.xlsm").Activate
    
    Sheets("Voorblad").Select
    
End Sub

Vinden jullie een oplossing?
TonyLa

 

[mvdvlist]

Gebruik Thisworkbook.Path ipv de drive letter of mappen...Dan wordt alles op dezelfde locatie opgeslagen als de locatie van het werkbook.

Voorbeeld:
Als de lacatie is bv: "M\Mijnmap\Mijnmap\Bestandnaam.xlsx"
Dan wordt het:

ThisWorkbook.SaveAs ThisWorkbook.Path & \Mijnbestand.xlsx"

 

[TonyLa]

Heb het volgende in de macro gezet
ThisWorkbook.SaveAs ThisWorkbook.Path & Range("B20") & (".xlsx")
Dit werkt niet, daarna dit geprobeert
ThisWorkbook.SaveAs ThisWorkbook.Path &\ Range("B20") & (".xlsx")
Werkt ook niet.
Ik krijg de foutmelding op deze regel

 

[TonyLa]

Het is ondertussen toch gelukt. Ik heb van SaveAs SaveCopyAS en het werkt.
Dank voor uw tip

 

[snb]

Hiermee kan het ook (Ter vervanging van jouw macro).

Sub M_snb()
  sn=Sheets("Printversie").Usedrange

  with workbooks.add
    .sheets(1).cells(1).resize(ubound(sn),ubound(sn,2))=sn
    .savecopyas Thisworkbook.path & sn(20,2) & ".xlsx"
    .close 0
  end with
End Sub