选择特定行直到循环中的最后一列

Question

I have two workbooks. One workbook has the calendar dates(Calendar.xlsm) and the other workbook has only the names(Workingdays.xlsm) of my class students. What i'm trying to do is to match the names in Workingdays.xlsm to Calendar.xlsx . If the match is found then copy the entire row (last filled cell) to Workingdays.xlsm.

So far i'm successful in matching the names in the two workbooks but unable to select the entire row for that matched names.

Sub Obtain_days()

' Open Calendar

Dim calendar_wb As Workbook

Dim calendar_ws As Worksheet

Dim Workdays_ws As Worksheet

Set calendar_wb = Workbooks.Open("C:\Users\XXX1\Desktop\Calendar.xlsx")

Set calendar_ws = calendar_wb.Worksheets("Sheet1")

Set Workdays_ws = Workbooks("Workingdays.xlsm").Worksheets("Sheet1")

' obtain dates

Workdays_ws.Activate

last_rw_Workdays = Workdays_ws.Range("A1000000").End(xlUp).Row

last_rw_calendar = calendar_ws.Range("A1000000").End(xlUp).Row

'last_col_calendar = calendar_ws.Range("XFD3").End(xlToLeft).Column

  ' loop through names <-------------Sucessful in matching names

For i = 3 To last_rw_Workdays

 findval = Workdays_ws.Range("A" & i).Value

  For j = 5 To last_rw_calendar

  If calendar_ws.Range("A" & j).Value = findval Then

  'calendar_ws.Range("C" & last_col_calendar).Copy

  calendar_ws.Cells(j, 32).Resize(1, 25).Copy Destination:=Workdays_ws.Cells(i, 3).Resize(1, 2) '<---failed in this step, copying irrelevant cell reference

  'ActiveSheet.Range((last_rw_calendar, 1),(last_rw_calendar, last_col_calendar)).Copy

  Workdays_ws.Activate

  'Workdays_ws.Range("B1000000").End(xlUp).Offset(1, 0).PasteSpecial

  End If

  Next j

Next i

End Sub

Failed to copy the entire row (Till last filed cell). Any help would be much appreciated

Answer 1

Without more details, I believe you actually want:

calendar_ws.Cells(j, 1).Resize(1, 25).Copy Destination:=Workdays_ws.Cells(i, 3)

This is assuming the "calendar_ws" row has 25 columns you want to copy over to "Workdays_ws" starting in column "C".