Macro USB stick

[basachempa]

Beste,

Ik heb een macro op een USB stick staan waarbij verwezen wordt naar een andere workbook (ook op die stick). Als ik die USB stick nu in een andere computer steek is het probleem dat de letter van de USB stick niet steeds dezelfde is, bestaat er hier een oplossing voor. Misschien een macro die alle mogelijke letters zoekt totdat de juiste workbook wordt gevonden?

Groeten,
Bart

 

[Haaren101]

In de Macro geen absolute adressering gebruiken maar relatieve

Ron

 

[basachempa]

Voorbeeld

Kun je eens een voorbeeldje geven?

Alvast bedankt voor de moeite,
Bart

 

[Haaren101]

"K:\map1\map2\filea.xls"
zoekt altijd op schijf K in de mappen map1\map2 naar filea.xls

"filea.xls"
zoekt in dezelfde map als waar de macro staat

"\map1\map2\filea.xls"
zoekt op de huidige schijf naar filea.xls in \map1\map2

Zet hier anders even een voorbeeld van de adres string

Ron

 

[basachempa]

Voorbeeld

Hier het voorbeeld:

For i = 0 To 11
On Error Resume Next
naam = Sheets("TOEWIJZING").Cells(rij + i, kolom).Value
'zoekcel = Sheets("VOORKEUR").Cells(rij, 2).Value
zoekcel = [F:\scheepsdoc exp\data\BASISDATA.xls].Sheets("VOORKEUR").Cells(rij, 2).Value
Do While naam <> zoekcel
'zoekcel = Sheets("VOORKEUR").Cells(rij2, 2).Value
zoekcel = [F:\scheepsdoc exp\data\BASISDATA.xls].Sheets("VOORKEUR").Cells(rij2, 2).Value
rij2 = rij2 + 1
If rij2 > 140 Then
MsgBox ("Naam niet gevonden") & " : " & naam
Exit Sub
End If
Loop

Nog een bijkomend vraagje:
Moet de workbook basisdata dan open zijn?

Groeten,
Bart

 

[Haaren101]

"F:\scheepsdoc exp\data\BASISDATA.xls" veranderen in

"\scheepsdoc exp\data\BASISDATA.xls"

Moet de workbook basisdata dan open zijn?

Als dit de hele macro is dan moet het workbook open zijn; anders eerst vanuit de macro openen

Ron

 

[basachempa]

voorbeeld

hier de volledige macro

Sub toewijzen()
Application.EnableEvents = False

rij = 16
rij2 = 16
kolom = 5
For i = 0 To 11
On Error Resume Next

naam = Sheets("TOEWIJZING").Cells(rij + i, kolom).Value
'zoekcel = Sheets("VOORKEUR").Cells(rij, 2).Value
zoekcel = [\scheepsdoc exp\data\BASISDATA.xls].Sheets("VOORKEUR").Cells(rij, 2).Value
Do While naam <> zoekcel
'zoekcel = Sheets("VOORKEUR").Cells(rij2, 2).Value
zoekcel = [\scheepsdoc exp\data\BASISDATA.xls].Sheets("VOORKEUR").Cells(rij2, 2).Value
rij2 = rij2 + 1
If rij2 > 140 Then
MsgBox ("Naam niet gevonden") & " : " & naam
Exit Sub
End If
Loop

'With Sheets("VOORKEUR")
With [F:\scheepsdoc exp\data\BASISDATA.xls].Sheets("VOORKEUR")
waarde = .Range(.Cells(rij2 - 1, 29), .Cells(rij2 - 1, 53))
End With
With Sheets("TOEWIJZING")
.Range(.Cells(rij + i, 12), .Cells(rij + i, 36)).Value = waarde '
End With
rij2 = 16
Next
Application.EnableEvents = True

End Sub

Blijkbaar iets mis want werkt niet ben nog aan het zoeken

Groeten,
Bart

 

[snb]

Kun je svp VBA-code tussen codetags (#) zetten ?

Sub toewijzen()
  on error resume next
  workbooks.open thisworkbook.path & "scheepsdoc exp\data\BASISDATA.xls"
  sq=thisworkbook.Sheets("TOEWIJZING").Cells(17, 5).resize(11)
  for i= 1 to ubound(sq)
    if workbooks("BASISDATA.xls").columns(2).find(sq(j,1))..value=sq(j,1) then exit for
  next
  if j > ubound(sq) then MsgBox "Niets gevonden" 
End Sub

 

[basachempa]

Bedankt

Beste,

Werkt perfect
Hartelijke dank voor de hulp

Groeten,
Bart