2

Right people, I’m back again for some more help. I have a workbook where I add new worksheets every month with information which is exactly the same as before in structure. In column A, I have invoice numbers then details from columns B:J. In columns K & L there are comments manually added for all outstanding issues. What I want to do is be able to lookup invoices against the last worksheet and then copy comments in columns K & L into the new worksheet.

I have tried to create a bit of code but nothing is coming off it. The ActiveSheet is the newly created without comments. So i want to lookup invoice numbers in columns A and copy columns K & L where a match is found from last worksheet to columns K&L of the activesheet. I hope I make sense and thank you for helping

Option Explicit

Sub FindCopy_all()

    Dim calc As Long
    Dim Cel As Range
    Dim LastRow As Long
    Dim rFound As Range
    Dim LookRange As Range
    Dim CelValue As Variant

     ' Speed
    calc = Application.Calculation
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

     'Get Last row of data ActiveSheet, Col A
    LastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row

     ' Set range to look in
    Set LookRange = ActiveSheet.Range("A1:A" & LastRow)

     ' Loop on each value (cell)
    For Each Cel In LookRange
         ' Get value to find
        CelValue = Cel.Value
         ' Look on previous sheet
        With Sheets(Sheets.Count - 3)

            Set rFound = .Cells.Find(What:=CelValue, _
            After:=.Cells(1, 1), LookIn:=xlValues, _
            Lookat:=xlWhole, MatchCase:=False)

             ' Reset
            On Error GoTo endo

             ' Not found, go next
            If rFound Is Nothing Then
                GoTo NextCel
            Else
                 ' Found. last sheet, Col K & L to Active Sheet found Row, Col K & L
                .Cells(rFound.Row, 11, 12).Resize(, 2).Copy ActiveSheet.Cells(Cel.Row, 11, 12)
            End If
        End With
NextCel:
    Next Cel
Set rFound = Nothing

     'Reset

endo:

    With Application
        .Calculation = calc
        .ScreenUpdating = True
    End With

End Sub
4

2 回答 2

1

您在with上一张纸上的声明中，并且不activesheet存在任何声明。利用：

.Cells(rFound.Row, 11).Resize(,2).Copy activesheet.Cells(cel.Row, 11)

此外，您不应该需要On Error Resume Next，因为返回的范围将是并且在您完成每个查找后nothing还要确保您。set rFound = nothing

NextCel:
set rFound = nothing

我的代码：

Option Explicit

Sub FindCopy_all()

    Dim calc As Long
    Dim Cel As Range
    Dim LastRow As Long
    Dim rFound As Range
    Dim LookRange As Range
    Dim CelValue As Variant

     ' Speed
    calc = Application.Calculation
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

     'Get Last row of data ActiveSheet, Col A
    LastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row

     ' Set range to look in
    Set LookRange = ActiveSheet.Range("A1:A" & LastRow)

     ' Loop on each value (cell)
    For Each Cel In LookRange
         ' Get value to find
        CelValue = Cel.Value
         ' Look on previous sheet
        With Sheets(Sheets.Count - 1)

            Set rFound = .Range("A:A").Find(What:=CelValue, _
            After:=.Cells(1, 1), LookIn:=xlValues, _
            Lookat:=xlWhole, MatchCase:=False)

             ' Not found, go next
            If rFound Is Nothing Then
                GoTo NextCel
            Else
                 ' Found. last sheet, Col K & L to Active Sheet found Row, Col K & L
                .Cells(rFound.Row, 11).Resize(, 2).Copy ActiveSheet.Cells(Cel.Row, 11)
            End If
        End With
NextCel:
    Set rFound = Nothing
    Next Cel

    With Application
        .Calculation = calc
        .ScreenUpdating = True
    End With

End Sub
于 2013-04-11T11:34:59.413 回答
0

My suggestion is that your VBA code puts VLOOKUP formulas in the new worksheet to retrieve the invoice information like this:

activesheet.Cells(cel.Row, 11).formula="=VLOOKUP(...)"

then in order to replace the formulas with text your code could use

activesheet.Cells(cel.Row, 11).Copy

followed by

activesheet.Cells(cel.Row, 11).PasteSpecial xlPasteValues to replace the formulas with just text values

try my code

 ' Speed
calc = Application.Calculation
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

 'Get Last row of data ActiveSheet, Col A
LastRow = ActiveSheet.Cells(activesheet.rows.count, 1).End(xlUp).Row

 ' Set VLOOKUP formula, search on the other sheet for the value in column A, return the value matchiung from column 11, and use EXACT MATCH.
'
' =VLOOKUP(A:A,Sheet1!A:L,11,FALSE) ' example
'
range("K1:K" & lastRow).formula="=VLOOKUP(A:A," & sheets(Worksheets.count-1).name & "!A:L,11, FALSE)"

activesheet.calculate
range("K1:K" & lastRow).copy
range("K1:K" & lastRow).pastespecial xlpastevalues ' remove the formulas

that should get you started, try stepping through that and check the VLOOKUP is acting on the right columns and let us know how you get on

Philip

于 2013-04-14T21:08:33.893 回答