Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1316 / 13644 ツリー ←次へ | 前へ→

【75111】別ファイルのシートを取り込んでコピーすると図面が出てこない ちえ 13/12/12(木) 9:56 質問[未読]
【75117】Re:別ファイルのシートを取り込んでコピー... γ 13/12/12(木) 20:24 発言[未読]
【75124】Re:別ファイルのシートを取り込んでコピー... ちえ 13/12/13(金) 11:54 質問[未読]
【75125】Re:別ファイルのシートを取り込んでコピー... γ 13/12/13(金) 19:39 発言[未読]

【75111】別ファイルのシートを取り込んでコピーす...
質問  ちえ  - 13/12/12(木) 9:56 -

引用なし
パスワード
   こんにちわ。
早速質問させていただきます。

別ブックからシートを取り込んでコピーするマクロを組んでいます。
図面があるのですが、実行すると『このイメージは現在表示できません』と出ます。
列は揃うけど行が揃わなかったりもします。
2003の時は動いていたんですが、2010で実行するとこうなります。

なんとか2010で動かしていきたいので、よろしくお願い致します。

  Application.ScreenUpdating = False

  fna = Application.GetOpenFilename(Title:="\")
  If fna = "False" Then Exit Sub
  
  Workbooks.Open fna
  
  f0 = ThisWorkbook.Name      
  f1 = ActiveWorkbook.Name     
  s1 = ActiveSheet.Name       
 
  If f1 Like "*sheet1*" Then
    f2 = "sheet1"
   ElseIf f1 Like "*sheet2*" Then
    f2 = "sheet2"
   ElseIf f1 Like "*sheet3*" Then
    f2 = "sheet3"
   End If
  
 
  Windows(f1).Activate
  Cells.Select
  Selection.Copy
  Windows(f0).Activate

  sc = Sheets.Count
  For i = sc To 1 Step -1
    sn = Sheets(i).Name
  
   If sn = f2 Then
     Sheets(sn).Select
     Range("A1").Select
     ActiveSheet.Paste
     Range("A1").Select
     ActiveWindow.Zoom = 80
     GoTo 100
    End If
  Next
  
100:
 
 
  Windows(f1).Activate
  Application.CutCopyMode = False
  Windows(f1).Close
 
  Application.ScreenUpdating = True
 
    
End Sub

【75117】Re:別ファイルのシートを取り込んでコピ...
発言  γ  - 13/12/12(木) 20:24 -

引用なし
パスワード
   ▼ちえ さん:
>別ブックからシートを取り込んでコピーするマクロを組んでいます。
>図面があるのですが、実行すると『このイメージは現在表示できません』と出ます。
それは、どの行を実行したときに表示されるのですか?
いずれにしても、開いたファイルの内容に依存した話のようなので、
なかなか的確なコメントをつけるのは難しいかもしれませんねえ。

【75124】Re:別ファイルのシートを取り込んでコピ...
質問  ちえ  - 13/12/13(金) 11:54 -

引用なし
パスワード
   ▼γ さん:
>▼ちえ さん:
>>別ブックからシートを取り込んでコピーするマクロを組んでいます。
>>図面があるのですが、実行すると『このイメージは現在表示できません』と出ます。
>それは、どの行を実行したときに表示されるのですか?
>いずれにしても、開いたファイルの内容に依存した話のようなので、
>なかなか的確なコメントをつけるのは難しいかもしれませんねえ。


すいません。
どう質問していいかわからずで言葉足らずでした。
上記の分は解決して、マクロを組みなおしたのですが、
次は保存ができなくなってしまいました。。

『いくつかの機能を削除、または修復することにより〜‥』

みたいなエラーが出て保存ができません。
何かアドバイスをお願い致します。

Sub 取込()
  Application.ScreenUpdating = False

  fna = Application.GetOpenFilename(Title:="\")
  If fna = "False" Then Exit Sub
  
  Workbooks.Open fna
  
  f0 = ThisWorkbook.Name      
  f1 = ActiveWorkbook.Name     
  s1 = ActiveSheet.Name       
 
  If f1 Like "*0*" Then
    f2 = "0"
   ElseIf f1 Like "*1*" Then
    f2 = "1"
   ElseIf f1 Like "*2*" Then
    f2 = "2"
   ElseIf f1 Like "*3*" Then
    f2 = "3"
   ElseIf f1 Like "*4*" Then
    f2 = "4"
   ElseIf f1 Like "*5*" Then
    f2 = "5"
  End If
  

  Windows(f1).Activate
  ActiveSheet.Cells.Select
  Selection.Copy
  ThisWorkbook.Activate

  sc = Sheets.Count
  For i = sc To 1 Step -1
    sn = Sheets(i).Name


   If sn = f2 Then
     Sheets(sn).Select
     Rows("1:35").Select
     ActiveSheet.Paste
     Rows("1:35").Select
  
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
     
  
      End If
  Next

  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  Windows(f1).Close
    
End Sub

【75125】Re:別ファイルのシートを取り込んでコピ...
発言  γ  - 13/12/13(金) 19:39 -

引用なし
パスワード
   確たる根拠はないのですが、
コードはさほど複雑なことをしていないのに、
その警告の文言などかたすると、
そのファイルが壊れかけているんじゃないでしょうか。
そんな気がします。
早めにバックアップなりとったほうがいい気がします。

1316 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free