Match WorkSheets back to a Master Worksheet with current years data on it.

[anthonyexcel]

I have 13 sheets of data. Each sheet has about 35000 entries and is set up the same. What I would like to do is take those 13 sheets and bring the second column (Column B) back to a Master Sheet. Column A Contains an ID # Column B the school ID. The master sheet has the current years data (ID in Col A and School in Col B) What I would like to do is bring back Column B from each sheet and place it on the master Sheet if it matches the ID. Thanks in advance!!!!

ID School 1111 11 2222 12 3333 11 4444 6 5555 7 6666 3 7777 2 8888 1 9999 8

This is what it would look like:

Book2 A B C D E F G H I J K L M N 1 ID CurrentSchool 2001 2020 2019 2018 2017 2016 2015 2014 2013 2012 2011 2010 2 1111 11 61 61 61 61 11 11 11 11 11 11 11 11 3 2222 12 90 90 90 90 90 90 90 90 90 90 90 90 4 3333 11 45 45 45 45 78 78 2 2 2 2 2 2 5 4444 6 12 12 12 12 12 4 4 5 5 5 5 5 6 5555 7 61 54 67 65 89 89 7 7 7 7 7 7 7 6666 3 43 43 43 43 6 7 7 7 7 7 4 4 8 7777 2 61 61 61 61 2 2 2 2 2 2 2 9 8888 1 89 89 89 89 89 6 6 7 7 7 7 7 10 9999 8 22 22 22 22 22 22 3 3 5 5 4 5 Sheet1

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, i As Long, v1 As Variant, v2 As Variant, ws As Worksheet, dic As Object, lCol As Long
    Set desWS = Sheets("Master")
    v1 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v1)
        If Not dic.Exists(v1(i, 1)) Then
            dic.Add v1(i, 1), i + 1
        End If
    Next i
    For Each ws In Sheets
        If ws.Name <> "Master" Then
            lCol = desWS.UsedRange.Columns.Count + 1
            v2 = ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
            For i = 1 To UBound(v2, 1)
                If dic.Exists(v2(i, 1)) Then
                    With desWS
                        .Cells(dic(v2(i, 1)), lCol) = v2(i, 2)
                    End With
                End If
            Next i
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[anthonyexcel]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, i As Long, v1 As Variant, v2 As Variant, ws As Worksheet, dic As Object, lCol As Long
    Set desWS = Sheets("Master")
    v1 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v1)
        If Not dic.Exists(v1(i, 1)) Then
            dic.Add v1(i, 1), i + 1
        End If
    Next i
    For Each ws In Sheets
        If ws.Name <> "Master" Then
            lCol = desWS.UsedRange.Columns.Count + 1
            v2 = ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
            For i = 1 To UBound(v2, 1)
                If dic.Exists(v2(i, 1)) Then
                    With desWS
                        .Cells(dic(v2(i, 1)), lCol) = v2(i, 2)
                    End With
                End If
            Next i
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

Mumps,

Thank you so much!!!!! Worked perfectly!!!! I appreciate your help and guidance!!!!! Have a great day!!!

 

[mumps]

You are very welcome.