[[20190808165338]]　『データの自動転記マクロ』（ちくわ）　ページの最後に飛ぶ

『データの自動転記マクロ』（ちくわ）

別ファイルのデータを自動転記したいと思い色々調べて試してみましたが

マクロは難しく手探りでやってみました。

自動マクロで下記の方法をやってみましたがボタンの数が多くなりすぎて

しまいます。

' Macro5 Macro
'

    Windows("年次有給休暇計画・実績表＜山本＞.xlsx").Activate
    Range("C10:BL12").Select
    Selection.Copy
    Windows("2019.1.xlsm").Activate
    Range("C6:D6").Select
    ActiveSheet.Paste
End Sub
Sub Macro6()
'
' Macro6 Macro
'

    Windows("年次有給休暇取得計画・実績表＜三浦＞.xlsx").Activate
    Range("C10:BL12").Select
    Selection.Copy
    Windows("2019.1.xlsm").Activate
    Range("C42:D42").Select
    ActiveSheet.Paste
End Sub
Sub Macro7()
'
' Macro7 Macro
'

    Windows("年次有給休暇取得計画・実績表＜田中＞.xlsx").Activate
    Range("C10:BL12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("2019.1.xlsm").Activate
    Range("C54:D54").Select
    ActiveSheet.Paste
End Sub

そこで一連の流れを一回でやってみました。

動きが悪くなりました。

Sub 更新1()
'
' 更新1 Macro
'

    Windows("年次有給休暇計画・実績表＜山本＞.xlsx").Activate
    Range("C10:BL12").Select
    Selection.Copy
    Windows("2019.1.xlsm").Activate
    Range("C6:D6").Select
    ActiveSheet.Paste
    Windows("年次有給休暇取得計画・実績表＜三浦＞.xlsx").Activate
    Range("C10:BL12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("2019.1.xlsm").Activate
    Range("C42:D42").Select
    ActiveSheet.Paste
    Windows("年次有給休暇取得計画・実績表＜田中＞.xlsx").Activate
    Range("C10:BL12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("2019.1.xlsm").Activate
    Range("C54:D54").Select
    ActiveSheet.Paste
    Range("H76").Select
End Sub

本当は26名ほどいるのでボタンが沢山なってしまうので良い方法は

ないでしょうか？

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

元の情報だと1人13行だったはずですが、マクロを見ると12行のようです。また、B列に名前があったはずですが、そこを避けているということは、転記先のB列にも名前があるのでしょう。おそらく、名前に一致した行に貼り付けるのが良いのでしょうけど、B列の名前とファイル名が完全一致しているかどうか判らないので、名前を無視して、見つけた順に貼り付けるコードにしています。（名前じゃなく、社員番号とかを使えば、微妙な違いは無くなるのですが）

対象ブックはマクロで開くので、予め他のブックは閉じておいてから実行してみてください。

 Sub test()
    Const cPATH = "c:\ブックのあるフォルダ\"
    Dim wk As Worksheet
    Dim cFile As String
    Dim iR As Long

    Application.ScreenUpdating = False
    iR = 6
    Set wk = ActiveSheet
    cFile = Dir(cPATH & "年次有給休暇計画・実績表＜*.xlsx")
    While cFile <> ""
        With Workbooks.Open(cPATH & cFile, False, True)
            .Sheets(1).Range("C10:BL12").Copy wk.Cells(iR, "C")
            iR = iR + 12
            .Close False
        End With
        cFile = Dir
    Wend
    Application.ScreenUpdating = True
 End Sub
（???） 2019/08/09(金) 09:49

コメント返信：

[ 一覧(最新更新順) ]

[[20190808165338]] 『データの自動転記マクロ』（ちくわ） ページの最後に飛ぶ

[[20190808165338]]　『データの自動転記マクロ』（ちくわ）　ページの最後に飛ぶ