Excel VBA - 当某些名称与另一个工作簿匹配时,复制并粘贴一系列单元格

时间:2013-12-16 11:07:04

标签: excel-vba vba excel

我正在开展一个项目,我有一个要点,我想将某些数据从一张纸复制到另一张。例如。如果在列"A"中,单元格包含"Hello",则复制单元格“E4”中的内容。 “IF”声明会起作用吗?

我目前为我的项目编写的代码是

Sub testfortito()
    Dim x As Workbook
    Dim y As Workbook
    Dim ws As Worksheet

    'this opens both workbooks
    Set x = Workbooks.Open("Location1")
    Set y = Workbooks.Open("Location2")

    'to do the copy
    x.Sheets("sheet3").Range("A2:AC2").Copy

    For Each ws In Worksheets
        If ws.Name <> "sheet3" Then
            ws.Range("E3").Copy
            Worksheets ("Sheet3")
        End If    
    Next ws
End Sub

1 个答案:

答案 0 :(得分:0)

试试这个

Sub testfortito()
    Dim colEtxt(), ctr

    ctr = 0
    With Sheet1.Range("A:A")
        Set txt = .Find(What:="hello", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not txt Is Nothing Then
            firstAddress = txt.Address
            Do
                ReDim Preserve colEtxt(ctr)
                colEtxt(ctr) = Range(txt.Address).Offset(0, 4).Value
                Set txt = .FindNext(txt)
                ctr = ctr + 1
            Loop While Not txt Is Nothing And txt.Address <> firstAddress
        End If
    End With

    'copy the array onto sheet2 using transpose technique
    Sheet2.Range("A1:A" & UBound(colEtxt) + 1) = WorksheetFunction.Transpose(colEtxt)
End Sub