Advertisement
Guest User

Untitled

a guest
Jun 17th, 2019
68
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.79 KB | None | 0 0
  1. With Application
  2. .ScreenUpdating = False
  3. .Calculation = xlCalculationManual
  4. .DisplayAlerts = False
  5. .EnableEvents = False
  6. End With
  7.  
  8. Set lo_b1 = x_bf1.ListObjects(1)
  9. s_date = CLng(ThisWorkbook.Names("in_fre_m").RefersToRange(1, 1))
  10. s_des = ThisWorkbook.Names("dr_no").RefersToRange(1, 1)
  11. s_code = ThisWorkbook.Names("dr_co").RefersToRange(1, 1)
  12. lastrow_d = lo_dr.Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
  13. Set pasterange1 = x_drill.Range("C" & lastrow_d)
  14.  
  15. With lo_b1.Range
  16. .AutoFilter Field:=13, Criteria1:=s_code
  17. .AutoFilter Field:=1, Criteria1:="<=" & s_date
  18. End With
  19.  
  20. lastrow_s = lo_b1.Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  21.  
  22. If lastrow_s > 7 Then
  23. Set copyrange1 = x_bf1.Range("D8:D" & lastrow_s) 'Date
  24. Set copyrange2 = copyrange1.Offset(0, 1) 'Description
  25. Set copyrange3 = copyrange1.Offset(0, 16) 'Calculation
  26. Set copyrange5 = copyrange1.Offset(0, 5) 'Classification
  27. Set copyrange6 = copyrange1.Offset(0, 6) 'Notes
  28. Set copyrange7 = copyrange1.Offset(0, 11) '§
  29. Set copyrange8 = copyrange1.Offset(0, 12) 'Code
  30. Set copyrange9 = copyrange1.Offset(0, 20) 'Statutory
  31. Set copyrange10 = copyrange1.Offset(0, 14) 'Ref
  32.  
  33.  
  34. copyrange10.SpecialCells(xlCellTypeVisible).Copy 'Ref
  35. pasterange1.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  36.  
  37. copyrange1.SpecialCells(xlCellTypeVisible).Copy 'Date
  38. pasterange1.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  39.  
  40. copyrange5.SpecialCells(xlCellTypeVisible).Copy 'Account Name
  41. pasterange1.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  42.  
  43. copyrange2.SpecialCells(xlCellTypeVisible).Copy 'Notes
  44. pasterange1.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  45.  
  46. copyrange8.SpecialCells(xlCellTypeVisible).Copy 'Code
  47. pasterange1.Offset(0, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  48.  
  49. copyrange7.SpecialCells(xlCellTypeVisible).Copy '§
  50. pasterange1.Offset(0, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  51.  
  52. copyrange3.SpecialCells(xlCellTypeVisible).Copy 'Calculation
  53. pasterange1.Offset(0, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  54.  
  55. copyrange9.SpecialCells(xlCellTypeVisible).Copy 'Statutory
  56. pasterange1.Offset(0, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  57.  
  58. copyrange6.SpecialCells(xlCellTypeVisible).Copy 'Notes
  59. pasterange1.Offset(0, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  60.  
  61. Set copyrange1 = Nothing
  62. Set copyrange2 = Nothing
  63. Set copyrange3 = Nothing
  64. Set copyrange4 = Nothing
  65. Set copyrange5 = Nothing
  66. Set copyrange6 = Nothing
  67. Set copyrange7 = Nothing
  68. Set copyrange8 = Nothing
  69. Set copyrange9 = Nothing
  70. Set copyrange10 = Nothing
  71. End If
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement