我正在尝试复制整行,但是我想将其添加到另一个工作表的顶部,将现有内容向下推一行。我已经从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
答案 0 :(得分:0)
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