代码之家  ›  专栏  ›  技术社区  ›  Wasteland

VBA-复制/插入行

  •  1
  • Wasteland  · 技术社区  · 6 年前

    我试图复制一整行,但我想将它添加到另一个工作表的顶部,将现有内容向下推一行。我把其他一些问题中的以下代码合并到SO中。它可以工作,但正如人们所料,它会替换目标工作表中第一行的内容。如何将其插入到目标工作表的顶部,以便将其他内容向下推。

    Sub CopyHeader()
    Dim sw As Worksheet: Set sw = ThisWorkbook.Sheets("OriginalFunding") 'source worksheet
    Dim tw As Worksheet: Set tw = ThisWorkbook.Sheets("FundingReturn") 'target worksheet
    Const WHAT_TO_FIND As String = "Learner"
    
                Set FoundCell = sw.Range("A:A").Find(What:=WHAT_TO_FIND)
                If Not FoundCell Is Nothing Then
                    sw.Rows(FoundCell.Row).EntireRow.Copy tw.Range("A1")
    
                Else
                    MsgBox (WHAT_TO_FIND & " not found")
                End If
    
    End Sub
    
    1 回复  |  直到 6 年前
        1
  •  0
  •   VBasic2008    6 年前

    插入班次

    “不允许对象引用”版本

    Sub CopyHeader()
    
      Const cSrc As String = "OriginalFunding"  ' Source Worksheet
      Const cTgt As String = "FundingReturn"    ' Target Worksheet
      Const cSrcRng As String = "A:A"           ' Source Range
      Const cTgtRng As String = "A1"            ' Target Range
      Const cSearch As String = "Learner"       ' Search String
    
      With ThisWorkbook.Sheets(cSrc)
        If Not .Range(cSrcRng).Find(What:=cSearch) Is Nothing Then
          .Range(cSrcRng).Find(What:=cSearch).EntireRow.Copy
          .Parent.Worksheets(cTgt).Range(cTgtRng).Insert (xlShiftDown)
          Application.CutCopyMode = False
         Else
          MsgBox "'" & cSearch & "' not found."
        End If
      End With
    
    End Sub