Excel VBA質問箱 IV

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

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


14490 / 76734 ←次へ | 前へ→

【67738】Re:パスワードが設定された複数ブック内のデータを一括してコピー貼り付けする
回答  UO3  - 11/1/6(木) 10:43 -

引用なし
パスワード
   ▼ケメ子 さん:

こんにちは

サーバーのパス名を適切なものに変更した上でお試しください。
元ブック側のG6からの行数が変動するわけで、残念ながら、元ブックも開きます。

Sub Sample2()
  Dim fPath As String  '元ブックのサーバパス
  Dim tPath As String  '先ブックのサーバパス
  Dim z As Long
  Dim shn As Variant
  Dim myFso As Object
  Dim myFiles As Object
  Dim myFile As Object
  Dim tCell As String
  Dim fName As String
  Dim fBook As Workbook
  Dim tBook As Workbook
  
  Application.ScreenUpdating = False
  Set myFso = CreateObject("Scripting.FileSystemObject")
  
  fPath = "c:\Test1"  '実際のサーバパス名に
  tPath = "c:\Test2"  '実際のサーバパス名に
  
  For Each myFile In myFso.GetFolder(tPath).Files
    fName = "【作業】" & myFile.Name
    If LCase(myFso.GetExtensionName(myFile.Name)) = "xls" And _
              myFso.FileExists(fPath & "\" & fName) Then
      Set fBook = Workbooks.Open(fPath & "\" & fName)
      Set tBook = Workbooks.Open(tPath & "\" & myFile.Name, Password:="abc")
      For Each shn In Array("A", "B", "C", "D")
      
        Select Case shn
          Case "A"
            tCell = "P5"
          Case "B"
            tCell = "C5"
          Case "C"
            tCell = "V5"
          Case "D"
            tCell = "N5"
        End Select
        
        z = fBook.Sheets(shn).Range("G6").End(xlDown).Row - 5
        tBook.Sheets(shn).Range(tCell).Resize(z).Value = _
              fBook.Sheets(shn).Range("G6").Resize(z).Value
              
      Next
      
      tBook.Close True
      fBook.Close False
      
    End If
  Next
  
  Set myFso = Nothing
  Set fBook = Nothing
  Set tBook = Nothing
  Application.ScreenUpdating = True
  
  MsgBox "処理が終了しました。"
  
End Sub

6 hits

【67726】パスワードが設定された複数ブック内のデータを一括してコピー貼り付けする ケメ子 11/1/4(火) 22:04 質問
【67728】Re:パスワードが設定された複数ブック内の... momo 11/1/5(水) 13:45 発言
【67729】Re:パスワードが設定された複数ブック内の... UO3 11/1/5(水) 18:26 回答
【67733】Re:パスワードが設定された複数ブック内の... ケメ子 11/1/5(水) 22:17 質問
【67734】Re:パスワードが設定された複数ブック内の... UO3 11/1/5(水) 22:23 発言
【67735】Re:パスワードが設定された複数ブック内の... ケメ子 11/1/5(水) 23:21 回答
【67738】Re:パスワードが設定された複数ブック内の... UO3 11/1/6(木) 10:43 回答
【67759】Re:パスワードが設定された複数ブック内の... ケメ子 11/1/6(木) 19:57 質問
【67760】原因がわかりました ケメ子 11/1/6(木) 21:28 質問
【67765】Re:原因がわかりました UO3 11/1/7(金) 6:47 回答
【67768】Re:原因がわかりました UO3 11/1/7(金) 9:17 回答
【67780】Re:原因がわかりました ケメ子 11/1/7(金) 21:39 発言
【67781】Re:原因がわかりました UO3 11/1/7(金) 22:33 回答
【67783】Re:原因がわかりました ケメ子 11/1/7(金) 23:31 お礼

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