粘貼到多行而不是單行

下面的代碼複製數據（Associate Entry命名範圍），並將其粘貼到不同工作表（AssociateData）中的特定行號（1RecRow）中。粘貼到多行而不是單行

我想將行粘貼到所有行，只在數字行下面。

有幾件事要牢記： A.數據被過濾，我希望粘貼影響過濾視圖（不是ALL - 未過濾 - 數據）中「1 RecRow」下的行。 B.如果有幫助，如果「1 RecRow」是23，那麼數據將以某種方式排序，然後下一行是24,25,26,27（按順序）。

人工手動我會做這樣：粘貼特定行中的數據，從1個RecRow再次複製數據，按Ctrl +移+向下箭頭和粘貼。我只是不知道如何調整代碼，以便它執行它。

感謝

Sub UpdateLogRecord() 

    Dim historyWks As Worksheet 
    Dim inputWks As Worksheet 

    Dim lRec As Long 
    Dim oCol As Long 
    Dim lRecRow As Long 

    Dim myCopy As Range 
    Dim myTest As Range 

    Dim lRsp As Long 

    Set inputWks = Worksheets("Input") 
    Set historyWks = Worksheets("AssociateData") 
    oCol = 3 'associate info is pasted on data sheet, starting in this column 

    'check for duplicate order ID in database 
    If inputWks.Range("CheckAssNo") = False Then 
     lRsp = MsgBox("Order ID not in database. Add record?", vbQuestion + vbYesNo, "New Order ID") 
     If lRsp = vbYes Then 
     UpdateLogWorksheet 
     Else 
     MsgBox "Please select Order ID that is in the database." 
     End If 

    Else 

     'cells to copy from Input sheet - some contain formulas 
     Set myCopy = inputWks.Range("AssociateEntry") 

     lRec = inputWks.Range("CurrRec").Value 
     lRecRow = lRec + 1 

     With inputWks 
      Set myTest = myCopy.Offset(0, 2) 

      If Application.Count(myTest) > 0 Then 
       MsgBox "Please fill in all the cells!" 
       Exit Sub 
      End If 
     End With 


     With historyWks 
      With .Cells(lRecRow, "A") 
       .Value = Now 
       .NumberFormat = "mm/dd/yyyy hh:mm:ss" 
      End With 
      .Cells(lRecRow, "B").Value = Application.UserName 

      myCopy.Copy 
      .Cells(lRecRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True 
      Application.CutCopyMode = False 
     End With  

     'clear input cells that contain constants 
     ClearDataEntry 
    End If 

End Sub

來源

2017-01-10 ewuchatka

要驗證，您想要覆蓋從每行中粘貼到表單最後一個使用行的所有數據？ – Cyril

是的，這是正確的，在過濾/當前查看。所以目前我正在查看過濾的數據，我看到C15到Q27。我希望將數據粘貼到編號行（已經在我的代碼中計算）中並將其粘貼到第27行（篩選數據中的最後一行）。 – ewuchatka

給予這是一個嘗試......你會指定可見單元格不覆蓋的隱藏物品。

Dim LR As Long 
    LR = Cells(Sheets("AssociateData").Rows.Count, 1).End(xlUp).Row 

     myCopy.Copy 
     .Range(Cells(lRecRow, 3), Cells(LR,3)).SpecialCells(xlCellTypeVisible).PasteSpecial xlValues 
     Application.CutCopyMode = False

這應該粘貼在定義的範圍內。我認爲這將是比FillDown ...這看起來像：

.Range(Cells(lRecRow, 3),Cells(LR,3)).FillDown

如果你想filldown，你會直接把在您粘貼值/公式後。

來源

2017-01-10 14:45:01 Cyril

西里爾，你是明星：）!!!!!!!!我不得不添加移調：=真，它的工作！你甚至無法想象我多麼感激你的幫助。我一直堅持着它！今天休息一下。我希望能像你有一天一樣擅長宏！ – ewuchatka

Cyril，當我通過點擊鍵盤上的F8運行宏時，它確實有效，但是，當我運行宏時，存在一個錯誤。它突出顯示以下行：.Range（Cells（lRecRow，3），Cells（LR，3））。SpecialCells（xlCellTypeVisible）.PasteSpecial xlValues，Transpose：= True，錯誤說：「運行時錯誤：1004。對象'_Worksheet'的'範圍'失敗。想知道爲什麼？ – ewuchatka

我猜想DIM需要在「With historyWks」之外發生，這可能會阻止我使用相應工作表的代碼？ LR作爲長到其他項目的頂部，離開LR =部分與.copy部分。 – Cyril

粘貼到多行而不是單行

回答

相關問題