|
お世話になっております。
昨日、ご教授頂いた時にはちゃんと抽出されていたのですが、
午前中、試してみたらコピー範囲が指定しているところと違う場所を
コピーしてしまいます。
原因が分からないのですが、ご教授頂けるでしょうか(+_+)
念の為、全コードを載せてみます。
Private Sub CommandButton1_Click()
Dim FileName As String
Dim MYPATH As String
Dim WB As Workbook
Dim r1 As Long
Dim r2 As Long
Dim Da1 As Date
Dim Da2 As Date
r1 = Range("B65536").End(xlUp).Row
If ThisWorkbook.Worksheets("保守期限一覧表").Range("B5:AR" & r1) < 5 Then
Worksheets("保守期限一覧表").Range("B5:AR" & r1).ClearContents
Else
End If
MYPATH = "\\1111\22222\出荷管理\管理表\管理表\"
strFileName = MYPATH & "管理表マスター" & ".xls"
If Dir(strFileName) <> "" Then
Set WB = Workbooks.Open(strFileName)
r2 = Range("D65536").End(xlUp).Row
With WB.Worksheets("管理表マスター")
If IsDate(Me.TextBox1.Value) And IsDate(Me.TextBox2.Value) Then
Da1 = Format(Me.TextBox1.Value, .Range("BG6").NumberFormat)
Da2 = Format(Me.TextBox2.Value, .Range("BG6").NumberFormat)
If .AutoFilterMode = False Then
.Range("M3:BG3").AutoFilter
End If
With .Range("M3:BG" & r2)
.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
Criteria2:="<=" & Da2
.AutoFilter field:=1, Criteria1:="=保守*"
If WB.Worksheets("管理表マスター").Range("M65536").End(xlUp).Row > 4 Then
.Range("B4:K" & r2).SpecialCells (xlCellTypeVisible).Copy 'B4〜Kまでコピーされず
ThisWorkbook.Worksheets("保守期限一覧表").Range("B5").PasteSpecial xlValues
.Range("M4:W" & r2).SpecialCells(xlCellTypeVisible).Copy 'N4からコピーされてしまいます。
ThisWorkbook.Worksheets("保守期限一覧表").Range("L5").PasteSpecial xlValues
.Range("AZ4:BU" & r2).SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Worksheets("保守期限一覧表").Range("W5").PasteSpecial xlValues
Application.CutCopyMode = False
Else
MsgBox "抽出データはありません", vbInformation
End If
WB.Worksheets("管理表マスター").AutoFilterMode = False
End With
Else
MsgBox "入力された値が日付として確認できませんでした", vbInformation
End If
End With
AutoFilterMode = False
Workbooks("管理表マスター.xls").Close savechanges:=False
Else
MsgBox strFileName & "がありません"
End If
Worksheets("保守期限一覧表").Select
Cells.EntireColumn.AutoFit
Range("A:A").Select
Selection.ColumnWidth = 4
Range("X:X").Select
Selection.ColumnWidth = 7.5
Range("Z:Z").Select
Selection.ColumnWidth = 7.5
Unload UserForm1
End Sub
|
|