Excel VBA Update: Find data, loop through multiple worksheets, copy range

前端 未结 2 1829
迷失自我
迷失自我 2021-01-22 20:39

Update to this thread from yesterday: Excel VBA: Find data, loop through multiple worksheets, copy specific range of cells

(Special thanks to findwindow for getting me t

相关标签:
2条回答
  • A quick note - and possibly the solution:

    I see you're working with multiple worksheets - this is fine, just remember to be hyper vigilant in setting ranges.

    For your Set copyRng, you correctly specify ws.Range, but you also need to do that for the Cells(). There are two fixes, use this: Set copyRng = ws.Range(ws.Cells(fRow, 1), ws.Cells(fRow, 18))

    Or, use With (my personal preference):

    With ws
        Set copyRng = .Range(.Cells(fRow,1),.Cells(fRow,18))
    End with
    

    In the With case, you'll notice you can just use a decimal as a placeholder for whatever your With __ is. (I like With, because if your worksheet variable is long, or you're just using the actual name, having to repeat that in thisIsMyWorksheet.Range(thisismyWorksheet.Cells(1,1),thisismyworksheet.cells(... can get quite long).

    If that doesn't do the trick, let me know. I've had spreadsheets hang up when I forget to explicitly give the Cells() worksheet, after giving the Range one.

    Edit: Per your comment, First, it looks like there's a typo in your If ring Is Nothing - should be If rng Is Nothing Then. I don't like that "If (TRUE) Then [implicitly do nothing]".

    Try this instead, for the worksheet loop:

    For Each ws In X.Worksheets
        With ws.Range("A:A")
            Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If Not rng Is Nothing Then
                fRow = rng.Row
                Set copyRng = ws.Range(ws.Cells(fRow, 1), ws.Cells(fRow, 18))
                Destination.Value = copyRng.Value
            End With
        Next ws
    
        Application.ScreenUpdating = True
    End Sub
    
    0 讨论(0)
  • 2021-01-22 21:16

    Not sure if this is what you are looking for? There was an end if missing? You can do the copy in a single line. See below ...

    For Each ws In X.Worksheets
        With ws.Range("A:A")
            Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If rng Is Nothing Then 'do nothing
              Else
              fRow = rng.Row
               ws.Range("A" + CStr(fRow) + ":" + "R" + CStr(fRow)).Copy Destination:=Destination
            End If
        End With
    Next ws
    
    0 讨论(0)
提交回复
热议问题