刪除與複製

myleoyes

各位前輩你們好!
         前輩!問題如附檔說明
         請知道的前輩,不吝賜教謝謝再三!!
         小弟在此誠摯的祝各位前輩!
           新年快樂!!事事如意,..

mistery

公式在附件寫的VBA裡

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target(1), Range("C1:IV1")) Is Nothing Then
    If Target(1) <> "" Then 複製
    End If
    If Not Intersect(Target(1), Range("C2:IV2")) Is Nothing Then
    If Target(1) <> "" Then 刪除
    End If
End Sub

---------------------------------------------------------------------------------------------------------
Sub 複製()
Again:
      ZZ = Application.InputBox("請輸入列數", "請輸入複製所需欄數", 10, Type:=2)
      If ZZ = "" Or ZZ = False Then End

      If ZZ <= 1 Then
        MsgBox "欄數不得小於１列！！！", , "欄數錯誤請重新輸入 ！！"
        GoTo Again
      End If
      [G1:P360].Copy Sheet2.Range("IV1").End(xlToLeft).Offset(0, 1)
End Sub

---------------------------------------------------------------------------------------------------------
Sub 刪除()
    Dim F
Again:
      ZZ = Application.InputBox("請輸入列數", "請輸入刪除所需欄數", 10, Type:=2)
      If ZZ = "" Or ZZ = False Then End

      If ZZ <= 1 Then
        MsgBox "欄數不得小於１列！！！", , "欄數錯誤請重新輸入 ！！"
        GoTo Again
      End If
    If Sheet1.[C1] = "" Then Exit Sub
    Columns("D:M").Delete Shift:=xlToLefte
End Sub

myleoyes

回復 2# mistery
mistery前輩你好!
       前輩!謝謝!!這是範例原來的程式
       並不適用的啊!不懂你的用意
       請知道的前輩,不吝賜教謝謝再三!!

myleoyes

回復 2# mistery
各位前輩你們好!
         這個問題的程式終於拼湊完成
         Sub 複製()
            Dim F As Range, A As Range
         Again:
            ZZ = Application.InputBox("請輸入列數", "請輸入複製所需欄數", 10, Type:=2)
            If ZZ = "" Or ZZ = False Then End
            Range("B1") = ZZ
            If ZZ <= 1 Then
            MsgBox "欄數不得小於１列！！！", , "欄數錯誤請重新輸入 ！！"
            GoTo Again
          End If
          With ActiveSheet
            Set F = .Rows(1).Cells.Find(.Cells(1, ActiveCell.Column))
            Set F = .Range(F.Offset(0), F.Offset(0, ZZ).End(xlDown))
          End With
            Set A = Sheet2.[IV1].End(xlToLeft).Offset(, 1)
            F.Copy A
          End Sub
          Sub 刪除()
          Again:
             ZZ = Application.InputBox("請輸入列數", "請輸入複製所需欄數", 10, Type:=2)
             If ZZ = "" Or ZZ = False Then End
             Range("B1") = ZZ
             If ZZ <= 1 Then
             MsgBox "欄數不得小於１列！！！", , "欄數錯誤請重新輸入 ！！"
             GoTo Again
          End If
          With ActiveSheet
             Set F = .Rows(1).Cells.Find(.Cells(1, ActiveCell.Column))
             Set F = .Range(F.Offset(0), F.Offset(0, ZZ).End(xlDown))
          End With
             F.Delete
          End Sub
         謝謝大家!!