VBAをエクステンションが不明な別のワークブックに移動する

Question

Worksheets("Hello").Move After:=Workbooks("FILE2").Sheets(1) 

アクティブなファイルが2つあります。 Hello.xlsbとFILE2.xlsb

上記のコードは、自分のコンピュータでのみ動作しますが、共有ドライブでは動作しません。 「下付き文字が範囲外のエラー」になっています。

機能させるには、拡張FILE2.xlsbを指定する必要があります。

しかし、これは任意の拡張子を持つ任意のFILE2で動作するようにしたいと思います。 その作業を行うには？

Answer 1

このコードでは、コピー先のブックを開いてシートを移動してもらうかどうかを尋ねるメッセージが表示されます。 FYIこれが理由かもしれ

Function GetWb(wbName As String) 
    Dim wb As Workbook, rv As Workbook 
    For Each wb In Application.Workbooks 
     If UCase(wb.Name) Like UCase(wbName & ".*") Then 
      Set rv = wb 
      Exit For 
     End If 
    Next wb 
    Set GetWb = rv 
End Function 

使用

Dim destWb As Workbook 

Set destWb = GetWb("file2") 
if destWb Is Nothing then 
    Msgbox "destination file not open!" 
else 
    'perform the copy 
end if 

：あなたのリンク先のブックが既に開いている場合

Public Sub Test() 

    Dim vfile As Variant 
    Dim wrkBk As Workbook 

    'Ask for the location of File2. 
    vfile = GetFile(ThisWorkbook.Path) 

    Set wrkBk = Workbooks.Open(vfile) 

    ThisWorkbook.Worksheets("Hello").Move After:=wrkBk.Worksheets(1) 

End Sub 


Function GetFile(Optional startFolder As Variant = -1) As Variant 
    Dim fle As FileDialog 
    Dim vItem As Variant 
    Set fle = Application.FileDialog(msoFileDialogFilePicker) 
    With fle 
     .Title = "Select a File" 
     .AllowMultiSelect = False 
     .Filters.Add "Excel Files", "*.xls*", 1 
     If startFolder = -1 Then 
      .InitialFileName = Application.DefaultFilePath 
     Else 
      If Right(startFolder, 1) <> "\" Then 
       .InitialFileName = startFolder & "\" 
      Else 
       .InitialFileName = startFolder 
      End If 
     End If 
     If .Show <> -1 Then GoTo NextCode 
     vItem = .SelectedItems(1) 
    End With 
NextCode: 
    GetFile = vItem 
    Set fle = Nothing 
End Function 

Answer 2

、あなたは安全に拡張子に関係なく、ブックを参照するためにこれを使用することができますコンピュータ間の相違点が表示されます。

Windows().Activate works on every computer except one