VBA code for Nested for loop, to look certain value and copy paste entire column in other sheet

Question

Current code - I have written a code, in which it will search for a value present in Sheet2 B1 cell, in sheet 1 and copy paste that entire column in "Column C " and "column D".

Required - I want to loop the same thing, once B1 in sheet 2 is executed, check for value in B2 (sheet2), in Sheet1, if found, create a new sheet and paste entire column value in "Column C and D". Loop should run til all the rows in Sheet2 column B and for each value found create new sheet and paste.

please help me loop and edit this code.

Current code

  Sub Look_copy()

Dim sh1 As Worksheet, sh2 As Worksheet
    Dim K As Long, l As Long, i As Long, nRow As Long
    Dim valuee1 As Variant


Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    K = 3
    l = 4
    nRow = 1
    valuee1 = Sheet2.Range("B1").Value

    For i = 1 To Columns.Count
        If sh1.Cells(nRow, i).Value = valuee1 Then
            sh1.Cells(nRow, i).EntireColumn.Copy sh2.Cells(1, K)
            sh1.Cells(nRow, i + 1).EntireColumn.Copy sh2.Cells(1, l)
            K = K + 1
            l = l + 1
        End If
    Next i
End Sub

Answer 1

From your code i can understand that you find a value in the first row, copy the whole column to COl C and D of sheet1. The below code does the same thing, but also loops for each cell in sheet 2 column B and adds new sheet before pasting. Try it!

Sub Macro2()
    Dim newSheet As Worksheet
    Dim x As Range

    'loop unitl last row in sheet2 column b
    For i = 1 To Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row  

        'find value in sheet1
        Set x = Sheets("Sheet1").Rows("1:1").Find(What:=Sheets("Sheet2").Range("B" & i), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

        'if value found
        If Not x Is Nothing Then

            'add new sheet
            Sheets.Add After:=Sheet1
            Set newSheet = ActiveSheet

            'copy entire column to column C nad D of new sheet
            Sheets("Sheet1").Columns(x.Column).Copy newSheet.Columns(3)
            Sheets("Sheet1").Columns(x.Column).Copy newSheet.Columns(4)
        End If
    Next i

End Sub

Update:

Below code to check values in column C in sheet3. For each value in Sheet2 Column C it will find the matching value in Sheet3 Row1, and copy values until the last row to Sheet2 Column B at the last available row.

Sub Macro3()
    Dim newSheet As Worksheet
    Dim x As Range

    'loop unitl last row in sheet2 column b
    For i = 1 To Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Row

        'find value in sheet1
        Set x = Sheets("Sheet3").Rows("1:1").Find(What:=Sheets("Sheet2").Range("C" & i), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

        'if value found
        If Not x Is Nothing Then

            With Sheets("Sheet3")
                .Range(x, .Cells(Rows.Count, x.Column).End(xlUp)).Copy _
                    Destination:=Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
            End With

        End If
    Next i

End Sub

Answer 2

this should do:

Option Explicit

Sub Look_copies()
    Dim rng1 As Range, cell As Range

    With Sheets("Sheet1")
        Set rng1 = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
    End With

    With Sheets("Sheet2")
        For Each cell In .Range("B1", .Cells(.Rows.Count, "B")).End(xlUp).SpecialCells(xlCellTypeConstants)
            If WorksheetFunction.CountIf(rng1, cell.Value) > 0 Then Look_copy cell, rng1, Sheets.Add(after:=Sheets(Sheets.Count))
        Next
    End With
End Sub


Sub Look_copy(valCell As Range, rng1 As Range, pasteSht As Worksheet)
    Dim valuee1 As Variant
    Dim cell As Range

    valuee1 = valCell.Value
    For Each cell In rng1
        If cell.Value = valuee1 Then
            cell.EntireColumn.Copy
            pasteSht.Cells(1, "C").Resize(, 2).PasteSpecial
            Application.CutCopyMode = False
        End If
    Next
End Sub