如何使用特定单词复制 excel 中的一行并粘贴到另一个 excel 工作表？-解网

问：

我已经检查了一堆不同的帖子，但似乎找不到我正在寻找的确切代码。此外，我以前从未使用过 VBA，所以我正在尝试从其他帖子中获取代码并输入我的信息以使其正常工作。还没有运气。在工作中，我们在Excel中有一个工资单系统。我正在尝试搜索我的名字，然后复制该行并将其粘贴到我保存在桌面上的工作簿中。"Clarke, Matthew""Total hours"

Excel VBA

Dim curBook As Workbook
Dim targetBook As Workbook
Dim curSheet As Worksheet
Dim targetSheet As Worksheet
Dim lastRow As Integer

Set curBook = ActiveWorkbook
Set curSheet = curBook.Worksheets("yourSheetName")

'change the Field number to the correct column
curSheet.Cells.AutoFilter Field:=1, Criteria1:="Clarke, Matthew" 

'The Offset is to remove the header row from the copy
curSheet.AutoFilter.Range.Offset(1).Copy  
curSheet.ShowAllData 

Set targetBook = Application.Workbooks.Open "PathTo Total Hours"
Set targetSheet = targetBook.WorkSheet("DestinationSheet")

lastRow = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row

targetSheet.Cells(lastRow + 1, 1).PasteSpecial

targetBook.Save
targetBook.Close

正如你所看到的，我为工作簿的特定设置放置了占位符。

Sub Sample()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim copyFrom As Range
    Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
    Dim strSearch As String
    
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("yourSheetName")
    
    strSearch = "Clarke, Matthew"
    
    With ws1

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> I am assuming that the names are in Col A
        '~~> if not then change A below to whatever column letter
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
       
        With .Range("A1:A" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With
        
        '~~> Remove any filters
        .AutoFilterMode = False
    End With
    
    '~~> Destination File
    Set wb2 = Application.Workbooks.Open("C:\Sample.xlsx")
    Set ws2 = wb2.Worksheets("Sheet1")
    
    With ws2
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 1
        End If
    
        copyFrom.Copy .Rows(lRow)
    End With
    
    wb2.Save
    wb2.Close
End Sub

快照

enter image description here

我保留了相同的内容，然后我尝试了 A1：A50，假设它意味着 A 列中第 1 行 - 50 的范围。还是没有运气..我刚刚意识到这张纸是受保护的，现在当我尝试在该纸上运行宏时，它说我不能。有没有其他方法可以解决这个问题？我不确定这些工作表是否允许使用宏

0赞 user1548751 7/27/2012

我将如何发送或发布它？怀疑我能从这些电脑上得到。此外，我使用未受保护的启用宏的文件运行了宏，它确实有效。当我尝试在其他受保护的文件上使用相同的宏时，我收到一个错误，我需要取消保护它才能执行此操作。

0赞 Siddharth Rout 7/27/2012

您没有该表的密码吗？

1赞 Excel Hero 8/21/2015 #3

我知道这已经很老了，但对于其他任何寻找如何做到这一点的人来说，它可以以更直接的方式完成：

Public Sub ExportRow()
    Dim v
    Const KEY = "Clarke, Matthew"
    Const WS = "Sheet1"
    Const OUTPUT = "c:\totalhours.xlsx"
    Const OUTPUT_WS = "Sheet1"

    v = ThisWorkbook.Sheets(WS).Evaluate("index(a:xfd,match(""" & KEY & """,a:a,),)")
    With Workbooks.Open(OUTPUT).Sheets(OUTPUT_WS)
        .[1:1].Offset(.[counta(a:a)]) = v
        .Parent.Save: .Parent.Close
    End With
End Sub

上一个：测试或检查工作表是否存在

下一个：如何反编译和重新编译数据库应用程序？

如何使用特定单词复制 excel 中的一行并粘贴到另一个 excel 工作表？

How to copy a line in excel using a specific word and pasting to another excel sheet?

评论

评论

评论