VBA 代码查找特定范围内的项目并复制到另一张表

Question

I want the code to find a P/N in a list which is on Sheet3. Once the P/N is found in that range, its corresponding global P/N, brand, description and list price which are all on the same row as P/N has to be copied and added to Sheet 2 under similar headings. The P/N will already be added in Sheet 2. The below is the code that I have tried for this. But, there is a compile error coming as "Next without For" even though Next is added for all the corresponding For in the code.

Sub Price()

Dim pno As Double
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Integer
Dim j As Integer

LastRowinMainSheet = Cells.Find(What:="*", _
                    After:=Range("E23"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

LastRow = Worksheets(3).UsedRange.SpecialCells(x1CellTypeLastCell).Row

For j = 24 To LastRowinMainSheet
Worksheets(2).Cells(j, 5).Value = pno

For i = 3 To LastRow
If Worksheets(3).Cells(i, 2).Value = pno Then
Worksheets(3).Cells(i, 3).Copy
Worksheets(2).Cells(j, 4).PasteSpecial xlPasteValues
Worksheets(3).Cells(i, 4).Copy
Worksheets(2).Cells(j, 6).PasteSpecial xlPasteValues
Worksheets(3).Cells(i, 5).Copy
Worksheets(2).Cells(j, 7).PasteSpecial xlPasteValues
Worksheets(3).Cells(i, 14).Copy
Worksheets(2).Cells(j, 12).PasteSpecial xlPasteValues
Next i

Next j


End Sub

Answer 1

You are missing end if

That'll have the same error msg within VBA.

edit 2021-03-25A Alright, so without knowing the exact shape of your data, I think your looking something like this:

Sub Price()

Dim pno As Double
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Integer
Dim j As Integer
                
LastRowinMainSheet = Worksheets(2).Cells(Worksheets(2).Rows.Count, "E").End(xlUp).Row

LastRow = Worksheets(3).Cells(Worksheets(2).Rows.Count, "E").End(xlUp).Row

For j = 24 To LastRowinMainSheet
    pno = Worksheets(2).Cells(j, 5).Value

    For i = 3 To LastRow
        If Worksheets(3).Cells(i, 2).Value = pno Then
            Worksheets(3).Cells(i, 3).Copy
            Worksheets(2).Cells(j, 4).PasteSpecial xlPasteValues
        
            Worksheets(3).Cells(i, 4).Copy
            Worksheets(2).Cells(j, 6).PasteSpecial xlPasteValues
        
            Worksheets(3).Cells(i, 5).Copy
            Worksheets(2).Cells(j, 7).PasteSpecial xlPasteValues
        
            Worksheets(3).Cells(i, 14).Copy
            Worksheets(2).Cells(j, 12).PasteSpecial xlPasteValues
        End If
     Next i
Next j


End Sub

This work on my machine.

Beware that the entries for pno [col 5 in sheets(2) and col 2 in sheets(3)] currently must be numbers.

In your code, swapping:

LastRowinMainSheet = Cells.Find(What:="*", _
                After:=Range("E23"), _
                LookAt:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

to

LastRowinMainSheet = Worksheets(3).Cells.Find(What:="*", _
                After:=Range("E23"), _
                LookAt:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

also worked for me.