Shane
05-19-2008, 11:21 PM
Hi,
I have made a macro which moves the records from sheet1 (weeks) to sheet2(YTD_QC) basis the column value weeks!E. If the column value is "Done" or "Delayed" then only the entire record copy and pasted in SHeet2(Ytd_qc) as first record.
The below record does the same however the only issue is when it pasted the record in (YTD_QC) is deleted the first record of YTD_QC which i don't want.
Sub Move()
Dim cl As Range
Dim rng As Range
Dim NextCl As Range, rngOutput As Range
Dim ShtName As String
Dim Del As Worksheet, Don As Worksheet
Set Del = ThisWorkbook.Sheets("YTD_QC")
Worksheets("weeks").Activate
Set rng = Worksheets("Weeks").Range(Cells(5, 5), Cells(Rows.Count, 1).End(xlUp))
For Each cl In rng
ShtName = cl.Value
If cl.Value = "done" Or cl.Value = "delayed" Then 'Or cl.Value = "Presentation" Then
' NextCl = Worksheets("YTD_QC").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
cl.EntireRow.Copy
Worksheets("YTD_QC").Activate
Set rngOutput = Worksheets("YTD_QC").Range("A4")
ActiveCell.EntireRow.Insert shift:=xlDown
rngOutput.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next cl
End Sub
Please help
I have made a macro which moves the records from sheet1 (weeks) to sheet2(YTD_QC) basis the column value weeks!E. If the column value is "Done" or "Delayed" then only the entire record copy and pasted in SHeet2(Ytd_qc) as first record.
The below record does the same however the only issue is when it pasted the record in (YTD_QC) is deleted the first record of YTD_QC which i don't want.
Sub Move()
Dim cl As Range
Dim rng As Range
Dim NextCl As Range, rngOutput As Range
Dim ShtName As String
Dim Del As Worksheet, Don As Worksheet
Set Del = ThisWorkbook.Sheets("YTD_QC")
Worksheets("weeks").Activate
Set rng = Worksheets("Weeks").Range(Cells(5, 5), Cells(Rows.Count, 1).End(xlUp))
For Each cl In rng
ShtName = cl.Value
If cl.Value = "done" Or cl.Value = "delayed" Then 'Or cl.Value = "Presentation" Then
' NextCl = Worksheets("YTD_QC").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
cl.EntireRow.Copy
Worksheets("YTD_QC").Activate
Set rngOutput = Worksheets("YTD_QC").Range("A4")
ActiveCell.EntireRow.Insert shift:=xlDown
rngOutput.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next cl
End Sub
Please help