E列に訪問会社名、I列に車の号車、K列に営業名があります

E列、I列、K列を含む予定表があります。
一日に何件も訪問するのですが、
N列に最初に訪問する時間を入れてます。

そこで、マクロのボタンを押すと、
N列の時間を入れている行を検索して
S列にK列の営業名、T列にI列の号車、U列にN列の時間
を表示させて出勤簿のようなものを作成したいのですが、
そういう事は、マクロで出来るのでしょうか？
どのようなマクロになるのか？？？
さっぱり分かりません(+_+)
マクロ初心の初心の初心者です(´・ω・`)
宜しくお願い致します。

No.1 回答者： tom04 回答日時： 2018/06/28 19:23

こんばんは！

一例です。
1行目は項目行でデータは2行目以降にあるという前提です。

Sub Sample1()
　Dim lastRow As Long
　　lastRow = Cells(Rows.Count, "I").End(xlUp).Row
　　　Range("N:N").AutoFilter field:=1, Criteria1:="<>"
　　　　If Cells(Rows.Count, "I").End(xlUp).Row > 1 Then
　　　　　Range(Cells(1, "K"), Cells(lastRow, "K")).SpecialCells(xlCellTypeVisible).Copy Range("S1")
　　　　　Range(Cells(1, "I"), Cells(lastRow, "I")).SpecialCells(xlCellTypeVisible).Copy Range("T1")
　　　　　Range(Cells(1, "N"), Cells(lastRow, "N")).SpecialCells(xlCellTypeVisible).Copy Range("U1")
　　　　Else
　　　　　MsgBox "該当データなし"
　　　　End If
　　　ActiveSheet.AutoFilterMode = False
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

有難うございます。
因みにコピーする先を同じフォルダの別ブックに
したりすることは出来ますか？

お礼日時：2018/06/29 13:08

No.2 回答者： tom04 回答日時： 2018/06/29 16:24

No.1です。

＞因みにコピーする先を同じフォルダの別ブックに・・・

別ブックのどのシートに貼り付けるのか不明なので、「Sheet1」とします。
そして、元データはマクロ記載ブックの「Sheet1」にあるという前提です。
貼り付け先の列は質問通りの列で良いのですね。
尚、マクロ記載ブック（元データのあるブック）は一旦名前を付けて保存しておいてください。

Sub Sample2()
　Dim lastRow As Long
　Dim myPath As String, fN As String
　Dim wB As Workbook, wS As Worksheet
　　myPath = ThisWorkbook.Path & "\"
　　fN = "貼り付け先.xlsx"
　　　Workbooks.Open (myPath & fN)
　　　　Set wB = ActiveWorkbook
　　　　Set wS = wB.Worksheets("Sheet1")
　　　　　With ThisWorkbook.Worksheets("Sheet1")
　　　　　　lastRow = .Cells(Rows.Count, "I").End(xlUp).Row
　　　　　　.Range("N:N").AutoFilter field:=1, Criteria1:="<>"
　　　　　　　If .Cells(Rows.Count, "I").End(xlUp).Row > 1 Then
　　　　　　　　Range(.Cells(1, "K"), .Cells(lastRow, "K")).SpecialCells(xlCellTypeVisible).Copy wS.Range("S1")
　　　　　　　　Range(.Cells(1, "I"), .Cells(lastRow, "I")).SpecialCells(xlCellTypeVisible).Copy wS.Range("T1")
　　　　　　　　Range(.Cells(1, "N"), .Cells(lastRow, "N")).SpecialCells(xlCellTypeVisible).Copy wS.Range("U1")
　　　　　　　Else
　　　　　　　　MsgBox "該当データなし"
　　　　　　　End If
　　　　　　.AutoFilterMode = False
　　　　　End With
　　　'//▼//
　　　With wB
　　　　.Save
　　　　.Close
　　　End With
　　　'//▲//
End Sub

※　コード内の「貼り付け先.xlsx」の部分は
実際のブック名（拡張子まで）に変更してください。

※　開いたブックは上書き保存して閉じるようにしていますが、
開いたままにしておきたい場合はコード内の「▼」～「▲」を消去してください。m(_ _)m

この回答へのお礼

遅くなりました(^_^;)
別ブックには上手くできなかったので、
とりあえず同シートにデータを写すように
してやってみます。
有難うございました。

お礼日時：2018/07/11 10:03