Copy Certain Cells to Another Sheet In Correct Row

[MarqyMarq]

Hi All! I am having an issue copying data (several fields) from one worksheet to another worksheet.... in the correct row of data.

The first sheet (Summary) has a a few student names and data listed. These names are compared to another sheet (Tutoring Attendance) and the "new" names added to the bottom of Tutoring Attendance. This part works!!!

Data in Columns D & E moved to certain columns based on the MONTH identified in Tutoring Attendance (Cell "B3"). This part also works.

The problem is my VBA code does NOT copy the remainder of the SUMMARY data (columns B thru E) to the correct student row listed in the Tutoring Attendance Tab. All I get it is the last row of data on the very last name of the Tutoring Attendance. I know I have a looping and an offset problem. Just can't figure it out.

Any assistance will be valuable.

Sub CopySummaryMonthlyData_TutoringMonthArea()

Dim wSum As Worksheet   '   Defined for STUDENT worksheets
Dim wTA As Worksheet    '   Defined for Tutoring Attendance worksheet
Dim lr As Integer, lrt As Integer   '   Defined to count the number of populated cells in row B of Tutoring Attendance worksheet

Set wTA = Worksheets("Tutoring Attendance")
Set wSum = Worksheets("Summary")
wTA.Activate    'Activates Tutoring Attendance worksheet

lr = 0          'Sets LR count to "0"
lrt = wTA.Cells(Rows.Count, 2).End(xlUp).Row - 4   'Counts the number of Student Names in row B of Tutoring Attendance worksheet


    ' *** Insert Monthly Values to Proper Spot ***  TESTING 12 Aug 2021
    ' Objective:  If Names are Present then add values to month column
    
    ' *** Finds month from Instructions page and and finds column in Tuturoing Attendance  rFind = columncount#
    Dim rFind As Range 'defined to identify column count
    Dim IRg As Range, xCell As Range, ARg As Range, MReqRg As Range, MActRg As Range
                 
    ICount = wSum.Cells(Rows.Count, 1).End(xlUp).Row      ' Counts the number of used rows in Summary
    
    Set IRg = wSum.Range("I4:I" & ICount)   ' Sets the range in row I, which is the criteria column
    
    Set MReqRg = wSum.Range("D4:D" & ICount)  '  Sets the range for Column D "Monthly Required"
            Set MActRg = wSum.Range("E4:E" & ICount)  '  Sets the range for Column E "Monthly Actual"
            
                With wTA.Range("E3:U3")
                Set rFind = .Find(What:=wTA.Range("B3"), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
                    If Not rFind Is Nothing Then
                    MsgBox "The Month " & rFind & " is in column " & rFind.Column
                    End If
                End With
               
    ' *** Copy Student Monthly Values from Summary to Tutoring Attendance *** Does NOT WORK *** 12 Aug 2021 requesting help from experts ***
    For K = 1 To IRg.Count
        MReqRg(K).Cells.Copy     'Times Required This Month
        'MsgBox MReqRg(K).Value2          ' Displays values for code verification
        wTA.Range("B65536").End(xlUp).Offset(0, rFind.Column - 2).PasteSpecial xlPasteValues    ' Subtracts 2 from previous offset above
        
        MActRg(K).Cells.Copy     'Times Tutored This Month
        'MsgBox MActRg(K).Value2           ' Displays Values for code verification
        wTA.Range("B65536").End(xlUp).Offset(0, rFind.Column - 1).PasteSpecial xlPasteValues    ' Subtracts 1 from previous offset above
    
        lr = lr + 1     'Increment lr count by 1 when a Student is added to Tutoring Attendance
        lrt = lrt + 1
    Next
    
MsgBox lr & " Students Updated!" & vbNewLine & vbNewLine & lrt & " Total students Listed"
    
End Sub

 

[Alex Blakenburg]

I might have to frame getting a mention in that illustrious company .
Thank you for sharing your success, glad we were able to make a contribution.