VBA: From all worksheet containing value in cell paste range

Question

I am brand new to VBA and learning on my own. I want to make a code in which I type a number in a cell (E4, last worksheet) and when run the macro, go and search for all worksheets that match that number in cell F2 and then for each worksheet that match the number, copy a range (which is a column) and then paste all columns in a new worksheet (added at the end). I have try some of the code below in different ways and sometimes work and sometimes does not. Among other problems, the problem with the code below is that when it works it is only copying one column from one finding. If there is a better, more elegant way to write this ( and make it work) your help is appreciated.

Sub abc()

Dim wscount As Integer
Dim wb As Workbook
Set wb = ActiveWorkbook
wscount = wb.Worksheets.Count
k = 1
j = 1 

If Worksheets(k).Range("F2").Value = Worksheets(wscount).Range("E4").Value Then
Worksheets(wscount + 1).Range(Cells(1, 1 + j), Cells(100, 1 + j)).Value = Worksheets(k).Range("F1:F100").Value
Worksheets(wscount + 1).Range(Cells(1, 1 + j), Cells(100, 1 + j)) = Worksheets(k).Range("F1:F100").Value

j = j + 1

End If

End Sub

A.S.H A.S.H · Accepted Answer · 2017-03-09T22:18:37

You were not adding a new sheet and you were not looping among the sheets. Here's a way to do it:

Sub abc()
    Dim wscount As Integer: wscount = Worksheets.Count
    Dim j As Long, k As Long
    Worksheets.Add After:=Worksheets(wscount)

    For k = 1 To wscount - 1
        If Worksheets(k).Range("F2").value = Worksheets(wscount).Range("E4").value Then
            j = j + 1
            Worksheets(wscount + 1).Columns(j).value = Worksheets(k).Columns("F").value
        End If
    Next
End Sub

VBA: From all worksheet containing value in cell paste range

1 Answers