プロが教える店舗&オフィスのセキュリティ対策術

お世話になります。下記のマクロ記述に変更を加えて、追加の作業を行いたいのですが、詳細は添付ファイルをご覧ください。どうぞよろしくお願いいたします。

Sub Sample()
Dim MacroB As Worksheet 'このブックのシート
Dim Wb_Data As Workbook '1. 分割元ブック
Dim Wb_new As Workbook '分割データ保存ブック
Dim Ws As String '2. 分割元シート名
Dim Path As String '3. 分割データ保存先
Dim C_Group As String '4. グループ対象列
Dim C_Copy As String '5. コピーデータ右端列
Dim YMD As String '6. 保存ブック日付の表示形式
Dim PSW As String '7. 読み取りパスワード
Dim R_Data As Integer 'データの行番号
Dim Ko As Integer 'グループの件数
Set MacroB = Workbooks("ex100010.xlsm").Worksheets(1) 'このブックのシート
Set Wb_Data = Workbooks(MacroB.Range("C11").Value) '分割元のブック名
Ws = MacroB.Range("C12")
Path = MacroB.Range("C13") & "¥"
C_Group = MacroB.Range("C14")
C_Copy = MacroB.Range("C15")
YMD = MacroB.Range("C16")
PSW = MacroB.Range("C17")
If YMD = "" Then
YMD = ""
Else
YMD = Format(Date, YMD)
End If
R_Data = 2 'データの開始行
Application.ScreenUpdating = False
Do
Wb_Data.Activate
Worksheets(Ws).Range(Cells(1, 1), Cells(1, C_Copy)).Copy '1行目の項目名コピー
Workbooks.Add
ActiveSheet.Paste Range("A1") '新規ブックに貼り付け
Set Wb_new = ActiveWorkbook
Wb_Data.Activate
Ko = WorksheetFunction.CountIf(Columns(C_Group), Cells(R_Data, C_Group)) 'グループの件数を算出
Range(Cells(R_Data, "A"), Cells(R_Data + Ko - 1, C_Copy)).Copy 'グループ件数分コピー
Wb_new.Activate
ActiveSheet.Paste Range("A2") '新規ブック項目の下に貼り付け
Wb_new.SaveAs Filename:=Path & Cells(2, C_Group) & YMD & ".xlsx", _
Password:=PSW '指定したフォルダーに保存
Wb_new.Close
R_Data = R_Data + Ko
Loop While Cells(R_Data, C_Group) <> ""
MsgBox "完了!"
Application.ScreenUpdating = True
End Sub

「【ご教示ください】VBAの記述方法がわか」の質問画像

A 回答 (2件)

こんばんは


ご説明を理解できていませんが
勝手な解釈で書きますので参考になればと思います・・(添削はしません

ActiveSheet.Paste Range("A2") '新規ブック項目の下に貼り付け
'①
ActiveSheet.Columns.AutoFit
'②
ActiveSheet.UsedRange.Borders.LineStyle = True
'③
Dim myname As String '条件不明
If ActiveSheet.Range("A2") <> "" Then
myname = ActiveSheet.Range("A2")
Else
myname = ActiveSheet.Range("A5")
End If
'④は 不明
Call my_Outlook(myname & Cells(2, C_Group) & YMD)

'名前の位置不明
Wb_new.SaveAs Filename:=Path & "\" & myname & Cells(2, C_Group) & YMD & ".xlsx", _
Password:=PSW '指定したフォルダーに保存
Wb_new.Close




End Sub

'要参照
Sub my_Outlook(mySubject As String)
Dim oApp As New Outlook.Application
Dim oItem As Outlook.MailItem
Set oItem = oApp.CreateItem(olMailItem)
With oItem
.Subject = mySubject
.Display
End With
Set oItem = Nothing
Set oApp = Nothing
End Sub
    • good
    • 0
この回答へのお礼

おはようございます。早速の返信いただきありがとうございました。
教えていただきました記述を解読?しながらトライしてみます。
追加で教えていただきたいのですが、下部に『'要参照』で始まる記述が
ありますが、こちらの意味?作業方法等を教えていただけますでしょうか。
よろしくお願いいたします。
失礼いたします。

お礼日時:2022/08/13 09:45

こんばんは。



直接の回答ではありませんが、マクロの記録はご存知でしょうか?

https://excel-ubara.com/excelvba1/EXCELVBA303.html

マクロの記録の状態で、
・A列からJ列を選択し、例えばI列とJ列の文字の間で、カーソルが、←|→
 の状態でダブルクリックする。
・セルA1を選んだ状態で、Ctrl + Shift + :キーを押す。(範囲選択)
 その状態で罫線を引く。
マクロの記録を終了させる。
上記で、①と②はコードが出来上がっているかと。
③と④の意味が、良く分かりません。
    • good
    • 1
この回答へのお礼

おはようございます。早速の返信いただきありがとうございました。
教えて頂いた内容で確認します。
失礼いたします。

お礼日時:2022/08/13 09:40

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング