Excel VBA質問箱 IV

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

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


13711 / 76732 ←次へ | 前へ→

【68524】Re:他のフォルダにあるファイル名をひな形ファイルにつけて保存する方法
発言  Yuki  - 11/3/14(月) 15:46 -

引用なし
パスワード
   ▼ケメ子 さん:
>今回は、フォルダの中に40近くのファイルがあり、これらすべてのファイル名と同じ名前で(先頭に【作業】とつきます)ひな形ファイルをコピー、保存したいと思っています。
Sub Macro21()
  Dim wb   As Workbook
  Dim strDirA As String
  Dim strDirB As String
  Dim wbA   As Workbook
  Dim wbB   As Workbook
  Dim sht   As Worksheet
  Dim shtB  As Worksheet
  Dim FSO   As Object
  Dim FC   As Object
  Dim F    As Object
  
  strDirA = ThisWorkbook.Path & "\A\"
  strDirB = ThisWorkbook.Path & "\B\"

  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set FC = FSO.GetFolder(strDirA).Files
  
  AppActivate Application.Caption
  Application.ScreenUpdating = False
  For Each F In FC                  ' Aフォルダの中の
    If Right(F.name, 4) = ".xls" Then        ' エクセルファイルで
    If FSO.FileExists(strDirB & F.name) Then    ' Bフォルダに同じ名前があったら
    
      ' Step1 : Cフォルダの作業用ファイルのひな形を開く。
          ' その際、ひな形は「読み取り専用を推奨する」になっているので、
          ' このダイアログを「いいえ」(編集可能で開く)にして開く
      DoEvents
      SendKeys "{TAB}{ENTER}"
      Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\C\雛形1.xls", ReadOnly:=False)

      ' Step2 : 開いたひな形に、Aフォルダと、Aフォルダと同名のBフォルダのファイル
          ' から転記作業を行う
      Set wbB = Workbooks.Open(strDirB & F.name) ' Bフォルダのエクセルを開く
      ' シートのコピーは前回のもので書き直してください。
      For Each shtB In wbB.Worksheets       'シートをコピー
        On Error Resume Next
        Set sht = wb.Worksheets(shtB.name)
        If Not sht Is Nothing Then
          shtB.Cells.Copy
          sht.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                      SkipBlanks:=False, Transpose:=False
        End If
        On Error GoTo 0
      Next
      
    ' Step3             ' Bフォルダに「作業」を付けて保存
      Application.DisplayAlerts = False
      wb.SaveAs Filename:=strDirB & "作業" & F.name, _
           FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
           ReadOnlyRecommended:=False, CreateBackup:=False
      wb.Close
      wbB.Close False
      Application.DisplayAlerts = True
    End If
    End If
  Next
  Set FSO = Nothing
  Application.ScreenUpdating = True
End Sub

0 hits

【68499】他のフォルダにあるファイル名をひな形ファイルにつけて保存する方法 ケメ子 11/3/10(木) 21:58 質問
【68504】Re:他のフォルダにあるファイル名をひな形... Yuki 11/3/11(金) 11:41 発言
【68506】Re:他のフォルダにあるファイル名をひな形... Yuki 11/3/11(金) 12:17 発言
【68521】Re:他のフォルダにあるファイル名をひな形... ケメ子 11/3/13(日) 22:23 質問
【68522】Re:他のフォルダにあるファイル名をひな形... UO3 11/3/14(月) 8:28 発言
【68524】Re:他のフォルダにあるファイル名をひな形... Yuki 11/3/14(月) 15:46 発言
【68527】Re:他のフォルダにあるファイル名をひな形... UO3 11/3/16(水) 11:04 発言
【68528】Re:他のフォルダにあるファイル名をひな形... ケメ子 11/3/16(水) 21:56 お礼
【68530】Re:他のフォルダにあるファイル名をひな形... ケメ子 11/3/17(木) 20:29 質問
【68531】Re:他のフォルダにあるファイル名をひな形... UO3 11/3/18(金) 9:03 発言
【68532】Re:他のフォルダにあるファイル名をひな形... UO3 11/3/18(金) 10:24 発言
【68533】Re:他のフォルダにあるファイル名をひな形... UO3 11/3/18(金) 11:11 発言
【68534】Re:他のフォルダにあるファイル名をひな形... UO3 11/3/18(金) 15:09 回答
【68535】Re:他のフォルダにあるファイル名をひな形... ケメ子 11/3/18(金) 22:23 お礼
【68824】Re:他のフォルダにあるファイル名をひな形... ケメ子 11/4/20(水) 21:30 お礼

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