返回列表 上一主題 發帖

點選複製

  1. Sub 多重分析()
  2.     Dim Rng As Range, A As Range
  3.     With Sheet1
  4.         Set Rng = .Range("I2").CurrentRegion
  5.         r = Selection.Count
  6.         If Not Intersect(Selection, Rng) Is Nothing Then
  7.         Set A = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
  8.             Application.Intersect(Selection.EntireRow, Rng).Copy A.Offset(, 8)
  9.             .[A2].Copy A
  10.             A.AutoFill A.Resize(r, 1)
  11.        End If
  12.     End With
  13. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 2# GBKEE
GBKEE良師你好!
   良師!謝謝!程式只能單選
             可否以修改有複選功能呢?  
          如附檔Leov34-2請再辛苦囉,謝謝再三!!

Leov34-2.rar (83.39 KB)

TOP

回復 1# myleoyes
  1. Sub 多重分析()
  2.     Dim Rng As Range
  3.     With Sheet1
  4.         Set Rng = .Range("I2").CurrentRegion
  5.         Set Rng = .Range(Rng(2, 1), Rng(Rng.Count))
  6.         If Not Intersect(ActiveCell, Rng) Is Nothing Then
  7.             .[A2].Copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
  8.             .Cells(ActiveCell.Row, "I").Resize(, 7).Copy .Range("I" & Rows.Count).End(xlUp).Offset(1)
  9.        End If
  10.     End With
  11. End Sub
複製代碼

TOP

        靜思自在 : 犯錯出懺悔心,才能清淨無煩惱。
返回列表 上一主題