VBA - Archive sheet help

[Omi2804]

Hi, I have been trying for several days and using many different codes to try to get this to work i am currently using the below code

When i use this code nothing happens but i dont get an error message either to help me figure out whats not working i am a complete newbie to VBA so any help would be appreciated. I am currently trying to get the code to work for one sheet only but i would need some help adapting the code for my other sheets in the workbook if someone can at least help either the code for one sheet / for all the sheets anything would help

My workbook

12 Sheets for each month
Completed sheet
Summary sheet
Master sheet

What i need

On each of the sheets for the month (Example below is for july sheet only as i havent been able to get that to work to even look at looping through all months ) but i would ideally like one code that loops through each sheet for the month only rather than having to individually complete each sheet
When there is a change for example : In "July" Column J starting from J5 from a drop down list if Completed is selected or cell value is equal to completed then copy entire row (my data starts in C column so copying from Column C the "Completed" sheet and paste with formula starting from C5 but paste below last row of data so the previous data is not overwritten. (I would like this for all the monthly sheets so when there is a change it automatically transfers if possible)

Once the row is copied i would like the row to be deleted from the original July sheet so that there is no blank rows in my data on my July sheet


Sub Archive()
Dim lastRow As Long
Dim i As Long

' Set the worksheet variables
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Set sourceSheet = ThisWorkbook.Sheets("July ")
Set targetSheet = ThisWorkbook.Sheets("completed")

' Find the last row of data in Column J on the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "J").End(xlUp).Row

' Loop through each row in Column J
For i = 5 To lastRow
' Check if the cell value is "completed"
If sourceSheet.Cells(i, "J").Value = "completed" Then
' Copy the entire row
sourceSheet.Rows(i).Copy

' Find the last row of data on the target sheet
Dim targetLastRow As Long
targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "C").End(xlUp).Row

' Paste special the row on the target sheet
targetSheet.Cells(targetLastRow + 1, "C").PasteSpecial Paste:=xlPasteValues
End If
Next i

' Clear the clipboard
Application.CutCopyMode = False
End Sub

 

[Skyybot]

I'm not sure if this is the problem, but it's good practice to completely define your Sheets with Workbook since you may have other open Workbooks if you have any Templates (such as PERSONAL MACROS) open with Excel. i.e. -

Dim wb as Workbook, sht as Worksheet
Set wb = Workbooks("Your_Workbook_Name.xlsx")
Set sht = wb.Sheets("Your_Sheet_Name")

 

[Omi2804]

I have managed to get the code somewhat working to one page but the top code copies the tasks to the bottom of the table on completed page and does not copy the formatting the second code copies the tasks to the top of the list but does not copy the tasks correctly it copies one task data info for the correct amount of completed tasks the only difference in the code seems to be the +1 in the row but i cant seem to figure out what i need to change
Sub Archive()
Dim lastRow As Long
Dim i As Long

' copies the tasks to the bottom of the list and does not copy formatting etc

' Set the worksheet variables
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Set sourceSheet = ThisWorkbook.Sheets("July ")
Set targetSheet = ThisWorkbook.Sheets("completed")

' Find the last row of data in Column J on the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "J").End(xlUp).Row

' Loop through each row in Column J
For i = 5 To lastRow
' Check if the cell value is "completed"
If sourceSheet.Cells(i, "J").Value = "Completed" Then
' Copy the entire row
sourceSheet.Range("C" & i & ":J" & i).Copy

' Find the last row of data on the target sheet
Dim targetLastRow As Long

targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "C").End(xlUp).Row + 1
' Paste special the row on the target shee
targetSheet.Range("C" & targetLastRow).PasteSpecial xlPasteValues

End If
Next i

' Clear the clipboard
Application.CutCopyMode = False
End Sub
Sub Archive2()
Dim lastRow As Long
Dim i As Long

' copies the tasks to the top of the list but does not copy the right tasks copy the same task 5 times only difference is the plus one on the row


' Set the worksheet variables
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Set sourceSheet = ThisWorkbook.Sheets("July ")
Set targetSheet = ThisWorkbook.Sheets("completed")

' Find the last row of data in Column J on the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "J").End(xlUp).Row

' Loop through each row in Column J
For i = 5 To lastRow
' Check if the cell value is "completed"
If sourceSheet.Cells(i, "J").Value = "Completed" Then
' Copy the entire row
sourceSheet.Range("C" & i & ":J" & i).Copy

' Find the last row of data on the target sheet
Dim targetLastRow As Long

targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "C").End(xlUp).Row
targetSheet.Range("C5:J" & lastRow).PasteSpecial xlPasteValues

End If
Next i

' Clear the clipboard
Application.CutCopyMode = False
End Sub