Copy and Paste Values from 1 Worksheet to Another Based on Column Criteria

[aroig07]

Hello there !!!! I am new to excel and trying to do a pretty big project and I cannot figure out how to solve an error that keeps popping up. I have a weekly schedule which has 7 columns, each one for a day of the week. I am now trying to do a daily schedule which copies all the values from the column pertaining to today's date. I have written this code, but I think I am not using the LastColumn as I should. Please help if possible and thank you in advance !!!

Here is the code I have written up until now:

Sub DailySchedule()

Application.ScreenUpdating = False


Dim todaydate As Date 'variable for todays date
Dim WeeklySchedule As Worksheet 'where is the data copied from
Dim DailySchedule As Worksheet 'where is the data pasted to
Dim LastColumn As Integer 'last column in weekly schedule sheet


'set variables of worksheets and ranges
Set WeeklySchedule = Sheets("Weekly Schedule")
Set DailySchedule = Sheets("Daily Schedule")
todaydate = Format(Date, "m/d/yyyy")


'clear old data from the master schedule sheet
DailySchedule.Range("B4:B1000").ClearContents


'go to weekly schedule and start searching on row 4 for the date and copying if matches today's date
WeeklySchedule.Visible = True
WeeklySchedule.Select
LastColumn = Cells(4, Rows.Count).End(xlUp).Row


'loop through the columns to find the matching records
For i = 2 To LastColumn
If Cells(4, i) = todaydate Then 'if the date matches todays date then copy the values
Range(Cells(1, i), Cells(1, i)).Copy 'copy column
DailySchedule.Select 'go to the daily schedule sheet
Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 'find first blank row and paste
WeeklySchedule.Select 'go back to the weekly schedule sheet and continue searching
End If
Next i


DailySchedule.Select 'so that the daily schedule is selected when the procedure ends
WeeklySchedule.Visible = False


End Sub

 

[Fluff]

Try

LastColumn = Cells(4, Columns.Count).End(xlToLeft).Column

 

[aroig07]

I was just going to post an update with that exact code, but its still not copying. Not showing an error, but also not copying the data and pasting it.

Sub DailySchedule()


Application.ScreenUpdating = False


Dim todaydate As Date 'variable for todays date
Dim WeeklySchedule As Worksheet 'where is the data copied from
Dim DailySchedule As Worksheet 'where is the data pasted to
Dim LastColumn As Integer 'last column in weekly schedule sheet


'set variables of worksheets and ranges
Set WeeklySchedule = Sheets("Weekly Schedule")
Set DailySchedule = Sheets("Daily Schedule")
todaydate = Format(Date, "m/d/yyyy")


'clear old data from the master schedule sheet
DailySchedule.Range("B4:B1000").ClearContents


'go to weekly schedule and start searching on row 4 for the date and copying if matches today's date
WeeklySchedule.Visible = True
WeeklySchedule.Select
LastColumn = Cells(4, Columns.Count).End(xlToLeft).Column


'loop through the columns to find the matching records
For i = 2 To LastColumn
If Cells(4, i) = todaydate Then 'if the date matches todays date then copy the values
Range(Cells(1, i), Cells(1, i)).Copy 'copy column
DailySchedule.Select 'go to the daily schedule sheet
Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 'find first blank row and paste
WeeklySchedule.Select 'go back to the weekly schedule sheet and continue searching
End If
Next i


DailySchedule.Select 'so that the daily schedule is selected when the procedure ends


End Sub

 

[aroig07]

FIXED !!! Just had to change the values in the range because it was only copying cell 1.


Sub DailySchedule()


Application.ScreenUpdating = False


Dim todaydate As Date 'variable for todays date
Dim WeeklySchedule As Worksheet 'where is the data copied from
Dim DailySchedule As Worksheet 'where is the data pasted to
Dim LastColumn As Integer 'last column in weekly schedule sheet


'set variables of worksheets and ranges
Set WeeklySchedule = Sheets("Weekly Schedule")
Set DailySchedule = Sheets("Daily Schedule")
todaydate = Format(Date, "m/d/yyyy")


'clear old data from the master schedule sheet
DailySchedule.Range("B4:B1000").ClearContents


'go to weekly schedule and start searching on row 4 for the date and copying if matches today's date
WeeklySchedule.Visible = True
WeeklySchedule.Select
LastColumn = Cells(4, Columns.Count).End(xlToLeft).Column


'loop through the columns to find the matching records
For i = 2 To LastColumn
If Cells(4, i) = todaydate Then 'if the date matches todays date then copy the values
Range(Cells(1, i), Cells(1000, i)).Copy 'copy column
DailySchedule.Select 'go to the daily schedule sheet
Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 'find first blank row and paste
WeeklySchedule.Select 'go back to the weekly schedule sheet and continue searching
End If
Next i


DailySchedule.Select 'so that the daily schedule is selected when the procedure ends


End Sub

 

[Fluff]

Glad you sorted it & thanks for the feedback