返回列表 上一主題 發帖

[發問] 請問VBA如何迴圈選取已篩選的資料複製到新工作表上的特定範圍

[發問] 請問VBA如何迴圈選取已篩選的資料複製到新工作表上的特定範圍

如題, 我想使用VBA去迴圈選取已篩選的資料複製到新工作表上的特定範圍及自動開新一行。
我嘗試錄製了巨集及修改了少許,但不成功。

VBA的 步驟:
    1.按下在SHEET “VBA” 上的 In out record 7 days按扭
    2.當按下制後,會選擇SHEET “AT”
    3.在SHEET”AT”上, 由A6拉到AD6, 之後按篩選
    4.之後在F6進行日期篩選,
    5.把SHEET “In out record” 複製一張新SHEET 叫 “In out record 2”
    6.把”In out record 2”複製一張新SHEET叫”In out record_AT”
    7.把剛才在SHEET “AT”上篩選得出的資料複製
    8.在SHEET ”In out record_AT” set C12 的VALUE 是AT
    9.在SHEET” In out record_AT” 的B17 貼上剛才所複製的資料,每複製一次,開新一行,  在新一行上繼續複製及不夠位自動INSERT新一行
    重複步驟4至8, 做7次(今日前3天到今日後3天,共7天)

我現在做到了1至8,但步驟9做了一次還可以,之後再複製就會覆蓋之前的資料
請問如何修改? 麻煩指導,感謝。

Code:
  1. Private Sub CommandButton17_Click()
  2. Set copysheet = ThisWorkbook.Sheets("In out record")
  3. copysheet.Activate
  4. copysheet.Range("A1:O49").Select
  5.     Selection.Copy
  6.     Sheets.Add After:=Sheets(Sheets.Count)
  7.     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
  8.         SkipBlanks:=False, Transpose:=False
  9.     ActiveSheet.Paste
  10.     ActiveSheet.Name = "In out record 2"
  11. Set copysheet2 = ThisWorkbook.Sheets("In out record 2")

  12. copysheet2.Copy After:=Sheets("In out record 2")
  13. Set ATworksheet = Sheets(Sheets("In out record 2").Index + 1)
  14. ATworksheet.Name = "In out record_AT"

  15. Set wSheetStart = ThisWorkbook.Sheets("AT")
  16. wSheetStart.Activate
  17. wSheetStart.AutoFilterMode = False
  18. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now - 3), Month(Now - 3), Day(Now - 3)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now - 3), Month(Now - 3), Day(Now - 3))
  19. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then

  20. Worksheets("AT").Range("B7").Select
  21.     Worksheets("AT").Range("B7:N7").Select
  22.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  23.     Selection.Copy
  24. ATworksheet.Activate
  25. ATworksheet.Range("B17").PasteSpecial

  26.   ATworksheet.Range("C12").Value = "AT"
  27.    
  28.     Set btn = ActiveSheet.Buttons.Add(477, 177, 40, 40)
  29.     With btn
  30.     .OnAction = "btnS"
  31.     .Caption = "Save As"
  32.     .Name = "Save As"
  33.     Application.ScreenUpdating = True
  34.     End With
  35.    
  36.     ATworksheet.Range("B21").Select
  37.    
  38.     wSheetStart.Activate
  39. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now - 2), Month(Now - 2), Day(Now - 2)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now - 2), Month(Now - 2), Day(Now - 2))
  40. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  41. Worksheets("AT").Range("B7").Select

  42.     Worksheets("AT").Range("B7:N7").Select

  43.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  44.     Selection.Copy
  45. ATworksheet.Activate
  46. ATworksheet.Range("B17").End(xlUp).Offset(1).PasteSpecial

  47. wSheetStart.Activate
  48. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now - 1), Month(Now - 1), Day(Now - 1)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now - 1), Month(Now - 1), Day(Now - 1))
  49. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  50. Worksheets("AT").Range("B7").Select

  51.     Worksheets("AT").Range("B7:N7").Select
  52.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  53.     Selection.Copy
  54. ATworksheet.Activate
  55. ATworksheet.Range("B17").End(xlUp).Offset(3).PasteSpecial

  56. wSheetStart.Activate
  57. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now), Month(Now), Day(Now)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now), Month(Now), Day(Now))
  58. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  59. Worksheets("AT").Range("B7").Select

  60.     Worksheets("AT").Range("B7:N7").Select
  61.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  62.     Selection.Copy
  63. ATworksheet.Activate
  64. ATworksheet.Range("B17").End(xlUp).Offset(5).PasteSpecial

  65. wSheetStart.Activate
  66. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now + 1), Month(Now + 1), Day(Now + 1)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now + 1), Month(Now + 1), Day(Now + 1))
  67. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  68. Worksheets("AT").Range("B7").Select
  69.     Worksheets("AT").Range("B7:N7").Select
  70.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  71.     Selection.Copy
  72. ATworksheet.Activate
  73. ATworksheet.Range("B17").End(xlUp).Offset(7).PasteSpecial

  74. wSheetStart.Activate
  75. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now + 2), Month(Now + 2), Day(Now + 2)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now + 2), Month(Now + 2), Day(Now + 2))
  76. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  77. Worksheets("AT").Range("B7").Select
  78.     Worksheets("AT").Range("B7:N7").Select
  79.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  80.     Selection.Copy
  81. ATworksheet.Activate
  82. ATworksheet.Range("B17").End(xlUp).Offset(9).PasteSpecial

  83. wSheetStart.Activate
  84. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now + 3), Month(Now + 3), Day(Now + 3)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now + 3), Month(Now + 3), Day(Now + 3))
  85. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  86. Worksheets("AT").Range("B7").Select
  87.     Worksheets("AT").Range("B7:N7").Select
  88.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  89.     Selection.Copy
  90. ATworksheet.Activate
  91. ATworksheet.Range("B17").End(xlUp).Offset(11).PasteSpecial

  92. End If
  93. End If
  94. End If
  95. End If
  96. End If
  97. End If
  98. End If
  99. End Sub
  100.    
複製代碼

有附檔會更好

TOP

        靜思自在 : 一個人的快樂.不是因為他擁有得多,而是因為他計較得少。
返回列表 上一主題