|
こんばんは
こんな感じで、
Private Sub CommandButton5_Click()
'先頭行を項目名行として、指定したセル範囲AutoFilterする。
Dim a As Variant
a = Application.InputBox( _
"半角数字で入力してください!", _
"絞り込みの日を入力して下さい! ", 1)
If VarType(a) = vbBoolean Then Exit Sub
With Application
.ScreenUpdating = False
'元のシート(AutoFilterで抽出するシート)
With Worksheets("元データ")
.Range("A1").AutoFilter Field:=3, Criteria1:=a
'抽出された行の可視セルのみCopyする。(先頭行はタイトルなので含めない)
With .AutoFilter.Range.Offset(1).Columns(5).Resize(, 29)
If Application.CountA(.Cells) = 0 Then
.Parent.AutoFilterMode = False
Exit Sub
End If
.Copy
End With
'貼り付けシート名
With Worksheets("日誌")
'貼付先の左上端のセルを指定値のみ複写
.Cells(36, 1).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
'AutoFilterの解除
.AutoFilterMode = False
End With
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
|
|