Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
Hello all.
I have a module with the following code snippet I have been trying to modify: Set wksPasteTo = Sheets("Closed_Requests") Sheets("Closed_Requests").Select 'ActiveSheet.Unprotect pw LR = Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row With Sheets("Distribution") For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then Range("B" & x).EntireRow.Copy With Sheets("Closed_Requests") wksPasteTo.Paste rngPasteTo Set rngPasteTo = rngPasteTo.Offset(1) End With Sheets("Distribution").Range("B" & x).EntireRow.Delete End If Next x End With I have seen several posts that use: Sheets("Sheet1").Cells.SpecialCells(xlTextValues). EntireRow.Copy Sheets("Sheet2").Cells.PasteSpecial Paste:=xlPasteValues but I have been unable to figure out how to merge the above with my code. There is one column 'B' that contains a color that I want to copy with the data, but all the rest of the combo boxes and code need to be stripped from the copied rows. I have another module with the following different code snippet that I need to copy and paste as above: 'create temporary worksheet Set AllName1 = Worksheets.Add(After:=Sheets(Sheets.Count)) AllName1.Name = frmALL.AllName.Value Set ws2 = ActiveSheet ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName & 13).Value With ws1 .Range("A2:" & colName & 1).Copy With ws2.Range("A3:" & colName & 1) ActiveSheet.Paste .RowHeight = 12 Range("A3").Select End With 'compares and copies data With Source LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For x = 2 To LastRow If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And ..Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then 'copies matched data to temporary sheet named by user RowsWithNumbers.EntireRow.Copy AllName1.Range("A3") End If End With 'Clear old report Sheets("All_Report").Range("A3:J" & Rows.Count).Clear 'Filter data based on dates chosen LR = Range("A" & Rows.Count).End(xlUp).Row 'Copy data ranges With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") With ws2 .Range("J3:K" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("H3") With ws2 .Range("O3:O" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("J3") End With End With End With Any help with these would be greatly appreciated!!!! Thanks!!! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
mke this change
from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Hello all. I have a module with the following code snippet I have been trying to modify: Set wksPasteTo = Sheets("Closed_Requests") Sheets("Closed_Requests").Select 'ActiveSheet.Unprotect pw LR = Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row With Sheets("Distribution") For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then Range("B" & x).EntireRow.Copy With Sheets("Closed_Requests") wksPasteTo.Paste rngPasteTo Set rngPasteTo = rngPasteTo.Offset(1) End With Sheets("Distribution").Range("B" & x).EntireRow.Delete End If Next x End With I have seen several posts that use: Sheets("Sheet1").Cells.SpecialCells(xlTextValues). EntireRow.Copy Sheets("Sheet2").Cells.PasteSpecial Paste:=xlPasteValues but I have been unable to figure out how to merge the above with my code. There is one column 'B' that contains a color that I want to copy with the data, but all the rest of the combo boxes and code need to be stripped from the copied rows. I have another module with the following different code snippet that I need to copy and paste as above: 'create temporary worksheet Set AllName1 = Worksheets.Add(After:=Sheets(Sheets.Count)) AllName1.Name = frmALL.AllName.Value Set ws2 = ActiveSheet ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName & 13).Value With ws1 .Range("A2:" & colName & 1).Copy With ws2.Range("A3:" & colName & 1) ActiveSheet.Paste .RowHeight = 12 Range("A3").Select End With 'compares and copies data With Source LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For x = 2 To LastRow If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then 'copies matched data to temporary sheet named by user RowsWithNumbers.EntireRow.Copy AllName1.Range("A3") End If End With 'Clear old report Sheets("All_Report").Range("A3:J" & Rows.Count).Clear 'Filter data based on dates chosen LR = Range("A" & Rows.Count).End(xlUp).Row 'Copy data ranges With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") With ws2 .Range("J3:K" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("H3") With ws2 .Range("O3:O" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("J3") End With End With End With Any help with these would be greatly appreciated!!!! Thanks!!! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
Thanks for replying Joel.
I tried that but the Paste:= is hilighted and a 'Compile error: Named argument not found' is displayed. Do I need to DIM 'Paste:=xlPasteValues', or part of it ? The variable 'rngPasteTo' is the cell location for the row to be pasted and I can not figure out how to meld it into 'wksPasteTo.PasteSpecial Paste:=xlPasteValues' without getting an error. "Joel" wrote: mke this change from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Hello all. I have a module with the following code snippet I have been trying to modify: Set wksPasteTo = Sheets("Closed_Requests") Sheets("Closed_Requests").Select 'ActiveSheet.Unprotect pw LR = Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row With Sheets("Distribution") For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then Range("B" & x).EntireRow.Copy With Sheets("Closed_Requests") wksPasteTo.Paste rngPasteTo Set rngPasteTo = rngPasteTo.Offset(1) End With Sheets("Distribution").Range("B" & x).EntireRow.Delete End If Next x End With I have seen several posts that use: Sheets("Sheet1").Cells.SpecialCells(xlTextValues). EntireRow.Copy Sheets("Sheet2").Cells.PasteSpecial Paste:=xlPasteValues but I have been unable to figure out how to merge the above with my code. There is one column 'B' that contains a color that I want to copy with the data, but all the rest of the combo boxes and code need to be stripped from the copied rows. I have another module with the following different code snippet that I need to copy and paste as above: 'create temporary worksheet Set AllName1 = Worksheets.Add(After:=Sheets(Sheets.Count)) AllName1.Name = frmALL.AllName.Value Set ws2 = ActiveSheet ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName & 13).Value With ws1 .Range("A2:" & colName & 1).Copy With ws2.Range("A3:" & colName & 1) ActiveSheet.Paste .RowHeight = 12 Range("A3").Select End With 'compares and copies data With Source LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For x = 2 To LastRow If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then 'copies matched data to temporary sheet named by user RowsWithNumbers.EntireRow.Copy AllName1.Range("A3") End If End With 'Clear old report Sheets("All_Report").Range("A3:J" & Rows.Count).Clear 'Filter data based on dates chosen LR = Range("A" & Rows.Count).End(xlUp).Row 'Copy data ranges With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") With ws2 .Range("J3:K" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("H3") With ws2 .Range("O3:O" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("J3") End With End With End With Any help with these would be greatly appreciated!!!! Thanks!!! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
I see what was wrong. wksPasteTo is a worksheet object and rngPasteTo is a
range object. originally from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues correction from wksPasteTo.Paste rngPasteTo to rngPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Thanks for replying Joel. I tried that but the Paste:= is hilighted and a 'Compile error: Named argument not found' is displayed. Do I need to DIM 'Paste:=xlPasteValues', or part of it ? The variable 'rngPasteTo' is the cell location for the row to be pasted and I can not figure out how to meld it into 'wksPasteTo.PasteSpecial Paste:=xlPasteValues' without getting an error. "Joel" wrote: mke this change from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Hello all. I have a module with the following code snippet I have been trying to modify: Set wksPasteTo = Sheets("Closed_Requests") Sheets("Closed_Requests").Select 'ActiveSheet.Unprotect pw LR = Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row With Sheets("Distribution") For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then Range("B" & x).EntireRow.Copy With Sheets("Closed_Requests") wksPasteTo.Paste rngPasteTo Set rngPasteTo = rngPasteTo.Offset(1) End With Sheets("Distribution").Range("B" & x).EntireRow.Delete End If Next x End With I have seen several posts that use: Sheets("Sheet1").Cells.SpecialCells(xlTextValues). EntireRow.Copy Sheets("Sheet2").Cells.PasteSpecial Paste:=xlPasteValues but I have been unable to figure out how to merge the above with my code. There is one column 'B' that contains a color that I want to copy with the data, but all the rest of the combo boxes and code need to be stripped from the copied rows. I have another module with the following different code snippet that I need to copy and paste as above: 'create temporary worksheet Set AllName1 = Worksheets.Add(After:=Sheets(Sheets.Count)) AllName1.Name = frmALL.AllName.Value Set ws2 = ActiveSheet ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName & 13).Value With ws1 .Range("A2:" & colName & 1).Copy With ws2.Range("A3:" & colName & 1) ActiveSheet.Paste .RowHeight = 12 Range("A3").Select End With 'compares and copies data With Source LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For x = 2 To LastRow If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then 'copies matched data to temporary sheet named by user RowsWithNumbers.EntireRow.Copy AllName1.Range("A3") End If End With 'Clear old report Sheets("All_Report").Range("A3:J" & Rows.Count).Clear 'Filter data based on dates chosen LR = Range("A" & Rows.Count).End(xlUp).Row 'Copy data ranges With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") With ws2 .Range("J3:K" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("H3") With ws2 .Range("O3:O" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("J3") End With End With End With Any help with these would be greatly appreciated!!!! Thanks!!! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
Thanks!! That works for the first part of my question.
For the second part, I have tried: With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3").PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range.PasteSpecial Paste:=xlPasteValues("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").PasteSpecial Paste:=xlPasteValues.Range("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Cells("A3").PasteSpecial Paste:=xlPasteValues and probably a couple more. I have 6 report modules based on this code which I think is bloating the spreadsheet with unnessary code copied with the data. I would guess that it is erroring out because of the .Range() but that is only a guess. Thoughts on how to modify this to work? Thanks again!! Andrew "Joel" wrote: I see what was wrong. wksPasteTo is a worksheet object and rngPasteTo is a range object. originally from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues correction from wksPasteTo.Paste rngPasteTo to rngPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Thanks for replying Joel. I tried that but the Paste:= is hilighted and a 'Compile error: Named argument not found' is displayed. Do I need to DIM 'Paste:=xlPasteValues', or part of it ? The variable 'rngPasteTo' is the cell location for the row to be pasted and I can not figure out how to meld it into 'wksPasteTo.PasteSpecial Paste:=xlPasteValues' without getting an error. "Joel" wrote: mke this change from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Hello all. I have a module with the following code snippet I have been trying to modify: Set wksPasteTo = Sheets("Closed_Requests") Sheets("Closed_Requests").Select 'ActiveSheet.Unprotect pw LR = Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row With Sheets("Distribution") For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then Range("B" & x).EntireRow.Copy With Sheets("Closed_Requests") wksPasteTo.Paste rngPasteTo Set rngPasteTo = rngPasteTo.Offset(1) End With Sheets("Distribution").Range("B" & x).EntireRow.Delete End If Next x End With I have seen several posts that use: Sheets("Sheet1").Cells.SpecialCells(xlTextValues). EntireRow.Copy Sheets("Sheet2").Cells.PasteSpecial Paste:=xlPasteValues but I have been unable to figure out how to merge the above with my code. There is one column 'B' that contains a color that I want to copy with the data, but all the rest of the combo boxes and code need to be stripped from the copied rows. I have another module with the following different code snippet that I need to copy and paste as above: 'create temporary worksheet Set AllName1 = Worksheets.Add(After:=Sheets(Sheets.Count)) AllName1.Name = frmALL.AllName.Value Set ws2 = ActiveSheet ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName & 13).Value With ws1 .Range("A2:" & colName & 1).Copy With ws2.Range("A3:" & colName & 1) ActiveSheet.Paste .RowHeight = 12 Range("A3").Select End With 'compares and copies data With Source LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For x = 2 To LastRow If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then 'copies matched data to temporary sheet named by user RowsWithNumbers.EntireRow.Copy AllName1.Range("A3") End If End With 'Clear old report Sheets("All_Report").Range("A3:J" & Rows.Count).Clear 'Filter data based on dates chosen LR = Range("A" & Rows.Count).End(xlUp).Row 'Copy data ranges With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") With ws2 .Range("J3:K" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("H3") With ws2 .Range("O3:O" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("J3") End With End With End With Any help with these would be greatly appreciated!!!! Thanks!!! |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
You didn't specify the error you are getting. I don't know wherre you are
decaring ws2, ws3, ... I suspect the sheets specified in the ranges are non on the same page and causing an error. See my comments below and my new code. I put the destination sheet in only one place in the code so you only have to make one change when going from one module to a 2nd module. Set wksPasteTo = Sheets("Closed_Requests") Remove Line - No need to select --------------------------------------- Sheets("Closed_Requests").Select ----------------------------------- 'ActiveSheet.Unprotect pw Add sheet reference ------------------------------------------------ from LR = Range("B" & Rows.Count).End(xlUp).Row to LR = wksPasteTo.Range("B" & Rows.Count).End(xlUp).Row ------------------------------------------------- Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) move inside with and add page reference ------------------------------------------------- Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row ------------------------------------------------- With Sheets("Distribution") ------------------------------------------------- from LastRow = Range("A65536").End(xlUp).Row to LastRow = .Range("A65536").End(xlUp).Row ------------------------------------------ For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then add sheet reference ------------------------------------------ from Range("B" & x).EntireRow.Copy to .Range("B" & x).EntireRow.Copy ------------------------------------------ Don't need with - sheet already specified in range above With Sheets("Closed_Requests") rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End With remove sheet refernce - already in with ------------------------------------------ from Sheets("Distribution").Range("B" & x).EntireRow.Delete to .Range("B" & x).EntireRow.Delete ------------------------------------------ End If Next x End With New Code Set wksPasteTo = Sheets("Closed_Requests") with wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) with Sheets("Distribution") LastRow = .Range("A65536").End(xlUp).Row For x = LastRow To 1 Step -1 If .Range("B" & x).Value = "Closed" Then .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) .Range("B" & x).EntireRow.Delete End If Next x End With "drewship" wrote: Thanks!! That works for the first part of my question. For the second part, I have tried: With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3").PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range.PasteSpecial Paste:=xlPasteValues("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").PasteSpecial Paste:=xlPasteValues.Range("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Cells("A3").PasteSpecial Paste:=xlPasteValues and probably a couple more. I have 6 report modules based on this code which I think is bloating the spreadsheet with unnessary code copied with the data. I would guess that it is erroring out because of the .Range() but that is only a guess. Thoughts on how to modify this to work? Thanks again!! Andrew "Joel" wrote: I see what was wrong. wksPasteTo is a worksheet object and rngPasteTo is a range object. originally from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues correction from wksPasteTo.Paste rngPasteTo to rngPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Thanks for replying Joel. I tried that but the Paste:= is hilighted and a 'Compile error: Named argument not found' is displayed. Do I need to DIM 'Paste:=xlPasteValues', or part of it ? The variable 'rngPasteTo' is the cell location for the row to be pasted and I can not figure out how to meld it into 'wksPasteTo.PasteSpecial Paste:=xlPasteValues' without getting an error. "Joel" wrote: mke this change from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Hello all. I have a module with the following code snippet I have been trying to modify: Set wksPasteTo = Sheets("Closed_Requests") Sheets("Closed_Requests").Select 'ActiveSheet.Unprotect pw LR = Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row With Sheets("Distribution") For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then Range("B" & x).EntireRow.Copy With Sheets("Closed_Requests") wksPasteTo.Paste rngPasteTo Set rngPasteTo = rngPasteTo.Offset(1) End With Sheets("Distribution").Range("B" & x).EntireRow.Delete End If Next x End With I have seen several posts that use: Sheets("Sheet1").Cells.SpecialCells(xlTextValues). EntireRow.Copy Sheets("Sheet2").Cells.PasteSpecial Paste:=xlPasteValues but I have been unable to figure out how to merge the above with my code. There is one column 'B' that contains a color that I want to copy with the data, but all the rest of the combo boxes and code need to be stripped from the copied rows. I have another module with the following different code snippet that I need to copy and paste as above: 'create temporary worksheet Set AllName1 = Worksheets.Add(After:=Sheets(Sheets.Count)) AllName1.Name = frmALL.AllName.Value Set ws2 = ActiveSheet ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName & 13).Value With ws1 .Range("A2:" & colName & 1).Copy With ws2.Range("A3:" & colName & 1) ActiveSheet.Paste .RowHeight = 12 Range("A3").Select End With 'compares and copies data With Source LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For x = 2 To LastRow If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then 'copies matched data to temporary sheet named by user RowsWithNumbers.EntireRow.Copy AllName1.Range("A3") End If End With 'Clear old report Sheets("All_Report").Range("A3:J" & Rows.Count).Clear 'Filter data based on dates chosen LR = Range("A" & Rows.Count).End(xlUp).Row 'Copy data ranges With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") With ws2 .Range("J3:K" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("H3") With ws2 .Range("O3:O" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("J3") End With End With End With Any help with these would be greatly appreciated!!!! Thanks!!! |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
Thanks Joel!!
I took what you provided and made some modifications so it would work in a manner I needed. ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A3" & (LR + 1)) With Sheets("Distribution") 'LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row LastRow = .Range("C65536").End(xlUp).Row ' For x = LastRow To 1 Step -1 For x = 3 To LastRow ' If .Range("B" & x).Value = "Closed" Then If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then RowsWithNumbers.EntireRow.Copy ' .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End If ' Next x End With End With There are 2 things that need some work. This code block in itself now pastes the rows starting at row 32 on the temporary sheet "wksPasteTo". Still trying to figure that out, but as a temporary workaround, I have added the following code to delete the blank lines before the rows are copied to the actual report: ' Delets blank rows Cells.Select On Error GoTo Exits: If Selection.Rows.Count 1 Then Set rng = Selection Else Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLast Cell).Row())) End If RwCnt = 0 For Rw = rng.Rows.Count To 1 Step -1 If Application.WorksheetFunction.CountA(rng.Rows(Rw). EntireRow) = 0 Then rng.Rows(Rw).EntireRow.Delete RwCnt = RwCnt + 1 End If Next Rw Exits: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Although this works, it increases processing time for the report. The last thing I need is to change the color of the status cells (column B) based on their content. In another sheets code, I have the following block I think could be reworked for my need: If Not Intersect(Target, Range("B:B")) Is Nothing Then Select Case Target.Value Case "Complete" If Cells(Target.Row, "D").Value < "" Then If MsgBox("Completion Date already exists. Update the date to today?", vbYesNo + vbQuestion) = vbNo Then GoTo ExitPoint End If Cells(Target.Row, "D").Value = Date icolor = 10 fcolor = 2 Case "In Progress" Cells(Target.Row, "D").Value = "" icolor = 8 Case "Items On Order" Cells(Target.Row, "D").Value = "" icolor = 6 Case "Researching" Cells(Target.Row, "D").Value = "" icolor = 3 fcolor = 2 Case "Closed" Cells(Target.Row, "D").Value = Cells(Target.Row, "D") icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Target .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With ActiveSheet.Protect pw, UserInterfaceOnly:=True End If Target row D is a date field I do not need in this use of Case, so I am looking for a way to get this to work. Is there an easier way? Thoughts?? Thanks again!!!! "Joel" wrote: You didn't specify the error you are getting. I don't know wherre you are decaring ws2, ws3, ... I suspect the sheets specified in the ranges are non on the same page and causing an error. See my comments below and my new code. I put the destination sheet in only one place in the code so you only have to make one change when going from one module to a 2nd module. Set wksPasteTo = Sheets("Closed_Requests") Remove Line - No need to select --------------------------------------- Sheets("Closed_Requests").Select ----------------------------------- 'ActiveSheet.Unprotect pw Add sheet reference ------------------------------------------------ from LR = Range("B" & Rows.Count).End(xlUp).Row to LR = wksPasteTo.Range("B" & Rows.Count).End(xlUp).Row ------------------------------------------------- Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) move inside with and add page reference ------------------------------------------------- Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row ------------------------------------------------- With Sheets("Distribution") ------------------------------------------------- from LastRow = Range("A65536").End(xlUp).Row to LastRow = .Range("A65536").End(xlUp).Row ------------------------------------------ For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then add sheet reference ------------------------------------------ from Range("B" & x).EntireRow.Copy to .Range("B" & x).EntireRow.Copy ------------------------------------------ Don't need with - sheet already specified in range above With Sheets("Closed_Requests") rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End With remove sheet refernce - already in with ------------------------------------------ from Sheets("Distribution").Range("B" & x).EntireRow.Delete to .Range("B" & x).EntireRow.Delete ------------------------------------------ End If Next x End With New Code Set wksPasteTo = Sheets("Closed_Requests") with wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) with Sheets("Distribution") LastRow = .Range("A65536").End(xlUp).Row For x = LastRow To 1 Step -1 If .Range("B" & x).Value = "Closed" Then .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) .Range("B" & x).EntireRow.Delete End If Next x End With "drewship" wrote: Thanks!! That works for the first part of my question. For the second part, I have tried: With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3").PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range.PasteSpecial Paste:=xlPasteValues("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").PasteSpecial Paste:=xlPasteValues.Range("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Cells("A3").PasteSpecial Paste:=xlPasteValues and probably a couple more. I have 6 report modules based on this code which I think is bloating the spreadsheet with unnessary code copied with the data. I would guess that it is erroring out because of the .Range() but that is only a guess. Thoughts on how to modify this to work? Thanks again!! Andrew "Joel" wrote: I see what was wrong. wksPasteTo is a worksheet object and rngPasteTo is a range object. originally from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues correction from wksPasteTo.Paste rngPasteTo to rngPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Thanks for replying Joel. I tried that but the Paste:= is hilighted and a 'Compile error: Named argument not found' is displayed. Do I need to DIM 'Paste:=xlPasteValues', or part of it ? The variable 'rngPasteTo' is the cell location for the row to be pasted and I can not figure out how to meld it into 'wksPasteTo.PasteSpecial Paste:=xlPasteValues' without getting an error. "Joel" wrote: mke this change from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Hello all. I have a module with the following code snippet I have been trying to modify: Set wksPasteTo = Sheets("Closed_Requests") Sheets("Closed_Requests").Select 'ActiveSheet.Unprotect pw LR = Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row With Sheets("Distribution") For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then Range("B" & x).EntireRow.Copy With Sheets("Closed_Requests") wksPasteTo.Paste rngPasteTo Set rngPasteTo = rngPasteTo.Offset(1) End With Sheets("Distribution").Range("B" & x).EntireRow.Delete End If Next x End With I have seen several posts that use: Sheets("Sheet1").Cells.SpecialCells(xlTextValues). EntireRow.Copy Sheets("Sheet2").Cells.PasteSpecial Paste:=xlPasteValues but I have been unable to figure out how to merge the above with my code. There is one column 'B' that contains a color that I want to copy with the data, but all the rest of the combo boxes and code need to be stripped from the copied rows. I have another module with the following different code snippet that I need to copy and paste as above: 'create temporary worksheet Set AllName1 = Worksheets.Add(After:=Sheets(Sheets.Count)) AllName1.Name = frmALL.AllName.Value Set ws2 = ActiveSheet ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName & 13).Value With ws1 .Range("A2:" & colName & 1).Copy With ws2.Range("A3:" & colName & 1) ActiveSheet.Paste .RowHeight = 12 Range("A3").Select End With 'compares and copies data With Source LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For x = 2 To LastRow If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then 'copies matched data to temporary sheet named by user RowsWithNumbers.EntireRow.Copy AllName1.Range("A3") End If End With 'Clear old report Sheets("All_Report").Range("A3:J" & Rows.Count).Clear 'Filter data based on dates chosen LR = Range("A" & Rows.Count).End(xlUp).Row 'Copy data ranges With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") With ws2 .Range("J3:K" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("H3") With ws2 .Range("O3:O" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("J3") End With End With End With Any help with these would be greatly appreciated!!!! Thanks!!! |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
the following code sets th elast line
' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row It is taking the last line of data in column C. Rows.count is the last row of the worksheet (65536). the XL commands can be duplicated using the keyboardf xlup - Shift-Cntl - Up Arrow xldown - Shift-Cntl - Down Arrow xltoleft - Shift-Cntl - left Arrow xlright - Shift-Cntl - right Arrow So if you select cell C100 with mouse and press the keys Shft-Cntl and then the up arrow you will get the last row of data. the new code you posted in the Cae Select aren't referencing a workshet. they are using the active worksheet which I can't tell which worksheet is the active worksheet. You should always specify a worksheet to prevent errors in the code like the first part of the code that has a "With wksPasteTo". the all the RANGE statement with a period in front is automatically using the worksheet wksPasteTo. the code in the select statement has Range without the period in front so I can't tell which is the active worksheet. "drewship" wrote: Below is the working code to change the colors of the Status cells so all that is left for the moment is to figure out why the merged code is starting the paste on line 32. Hopefully you or someone else can help with that. I have tried steppiing through the code but can't see the problem: LR = Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To LR If Not IsEmpty(Cells(i, "B")) Then Select Case Destination.Cells(i, "B").Value Case "Complete" icolor = 10 fcolor = 2 Case "In Progress" icolor = 8 Case "Items On Order" icolor = 6 Case "Researching" icolor = 3 fcolor = 2 Case "Closed" icolor = 5 fcolor = 2 Case "" icolor = 2 ' Case Else: icolor = 0 End Select With Destination.Cells(i, "B") .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With End If fcolor = xlColorIndexAutomatic Next i Thanks!! Andrew "drewship" wrote: Thanks Joel!! I took what you provided and made some modifications so it would work in a manner I needed. ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A3" & (LR + 1)) With Sheets("Distribution") 'LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row LastRow = .Range("C65536").End(xlUp).Row ' For x = LastRow To 1 Step -1 For x = 3 To LastRow ' If .Range("B" & x).Value = "Closed" Then If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then RowsWithNumbers.EntireRow.Copy ' .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End If ' Next x End With End With There are 2 things that need some work. This code block in itself now pastes the rows starting at row 32 on the temporary sheet "wksPasteTo". Still trying to figure that out, but as a temporary workaround, I have added the following code to delete the blank lines before the rows are copied to the actual report: ' Delets blank rows Cells.Select On Error GoTo Exits: If Selection.Rows.Count 1 Then Set rng = Selection Else Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLast Cell).Row())) End If RwCnt = 0 For Rw = rng.Rows.Count To 1 Step -1 If Application.WorksheetFunction.CountA(rng.Rows(Rw). EntireRow) = 0 Then rng.Rows(Rw).EntireRow.Delete RwCnt = RwCnt + 1 End If Next Rw Exits: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Although this works, it increases processing time for the report. The last thing I need is to change the color of the status cells (column B) based on their content. In another sheets code, I have the following block I think could be reworked for my need: If Not Intersect(Target, Range("B:B")) Is Nothing Then Select Case Target.Value Case "Complete" If Cells(Target.Row, "D").Value < "" Then If MsgBox("Completion Date already exists. Update the date to today?", vbYesNo + vbQuestion) = vbNo Then GoTo ExitPoint End If Cells(Target.Row, "D").Value = Date icolor = 10 fcolor = 2 Case "In Progress" Cells(Target.Row, "D").Value = "" icolor = 8 Case "Items On Order" Cells(Target.Row, "D").Value = "" icolor = 6 Case "Researching" Cells(Target.Row, "D").Value = "" icolor = 3 fcolor = 2 Case "Closed" Cells(Target.Row, "D").Value = Cells(Target.Row, "D") icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Target .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With ActiveSheet.Protect pw, UserInterfaceOnly:=True End If Target row D is a date field I do not need in this use of Case, so I am looking for a way to get this to work. Is there an easier way? Thoughts?? Thanks again!!!! "Joel" wrote: You didn't specify the error you are getting. I don't know wherre you are decaring ws2, ws3, ... I suspect the sheets specified in the ranges are non on the same page and causing an error. See my comments below and my new code. I put the destination sheet in only one place in the code so you only have to make one change when going from one module to a 2nd module. Set wksPasteTo = Sheets("Closed_Requests") Remove Line - No need to select --------------------------------------- Sheets("Closed_Requests").Select ----------------------------------- 'ActiveSheet.Unprotect pw Add sheet reference ------------------------------------------------ from LR = Range("B" & Rows.Count).End(xlUp).Row to LR = wksPasteTo.Range("B" & Rows.Count).End(xlUp).Row ------------------------------------------------- Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) move inside with and add page reference ------------------------------------------------- Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row ------------------------------------------------- With Sheets("Distribution") ------------------------------------------------- from LastRow = Range("A65536").End(xlUp).Row to LastRow = .Range("A65536").End(xlUp).Row ------------------------------------------ For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then add sheet reference ------------------------------------------ from Range("B" & x).EntireRow.Copy to .Range("B" & x).EntireRow.Copy ------------------------------------------ Don't need with - sheet already specified in range above With Sheets("Closed_Requests") rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End With remove sheet refernce - already in with ------------------------------------------ from Sheets("Distribution").Range("B" & x).EntireRow.Delete to .Range("B" & x).EntireRow.Delete ------------------------------------------ End If Next x End With New Code Set wksPasteTo = Sheets("Closed_Requests") with wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) with Sheets("Distribution") LastRow = .Range("A65536").End(xlUp).Row For x = LastRow To 1 Step -1 If .Range("B" & x).Value = "Closed" Then .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) .Range("B" & x).EntireRow.Delete End If Next x End With "drewship" wrote: Thanks!! That works for the first part of my question. For the second part, I have tried: With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3").PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range.PasteSpecial Paste:=xlPasteValues("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").PasteSpecial Paste:=xlPasteValues.Range("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Cells("A3").PasteSpecial Paste:=xlPasteValues and probably a couple more. I have 6 report modules based on this code which I think is bloating the spreadsheet with unnessary code copied with the data. I would guess that it is erroring out because of the .Range() but that is only a guess. Thoughts on how to modify this to work? Thanks again!! Andrew "Joel" wrote: I see what was wrong. wksPasteTo is a worksheet object and rngPasteTo is a range object. originally from wksPasteTo.Paste rngPasteTo |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
Below is the working code to change the colors of the Status cells so all
that is left for the moment is to figure out why the merged code is starting the paste on line 32. Hopefully you or someone else can help with that. I have tried steppiing through the code but can't see the problem: LR = Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To LR If Not IsEmpty(Cells(i, "B")) Then Select Case Destination.Cells(i, "B").Value Case "Complete" icolor = 10 fcolor = 2 Case "In Progress" icolor = 8 Case "Items On Order" icolor = 6 Case "Researching" icolor = 3 fcolor = 2 Case "Closed" icolor = 5 fcolor = 2 Case "" icolor = 2 ' Case Else: icolor = 0 End Select With Destination.Cells(i, "B") .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With End If fcolor = xlColorIndexAutomatic Next i Thanks!! Andrew "drewship" wrote: Thanks Joel!! I took what you provided and made some modifications so it would work in a manner I needed. ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A3" & (LR + 1)) With Sheets("Distribution") 'LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row LastRow = .Range("C65536").End(xlUp).Row ' For x = LastRow To 1 Step -1 For x = 3 To LastRow ' If .Range("B" & x).Value = "Closed" Then If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then RowsWithNumbers.EntireRow.Copy ' .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End If ' Next x End With End With There are 2 things that need some work. This code block in itself now pastes the rows starting at row 32 on the temporary sheet "wksPasteTo". Still trying to figure that out, but as a temporary workaround, I have added the following code to delete the blank lines before the rows are copied to the actual report: ' Delets blank rows Cells.Select On Error GoTo Exits: If Selection.Rows.Count 1 Then Set rng = Selection Else Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLast Cell).Row())) End If RwCnt = 0 For Rw = rng.Rows.Count To 1 Step -1 If Application.WorksheetFunction.CountA(rng.Rows(Rw). EntireRow) = 0 Then rng.Rows(Rw).EntireRow.Delete RwCnt = RwCnt + 1 End If Next Rw Exits: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Although this works, it increases processing time for the report. The last thing I need is to change the color of the status cells (column B) based on their content. In another sheets code, I have the following block I think could be reworked for my need: If Not Intersect(Target, Range("B:B")) Is Nothing Then Select Case Target.Value Case "Complete" If Cells(Target.Row, "D").Value < "" Then If MsgBox("Completion Date already exists. Update the date to today?", vbYesNo + vbQuestion) = vbNo Then GoTo ExitPoint End If Cells(Target.Row, "D").Value = Date icolor = 10 fcolor = 2 Case "In Progress" Cells(Target.Row, "D").Value = "" icolor = 8 Case "Items On Order" Cells(Target.Row, "D").Value = "" icolor = 6 Case "Researching" Cells(Target.Row, "D").Value = "" icolor = 3 fcolor = 2 Case "Closed" Cells(Target.Row, "D").Value = Cells(Target.Row, "D") icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Target .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With ActiveSheet.Protect pw, UserInterfaceOnly:=True End If Target row D is a date field I do not need in this use of Case, so I am looking for a way to get this to work. Is there an easier way? Thoughts?? Thanks again!!!! "Joel" wrote: You didn't specify the error you are getting. I don't know wherre you are decaring ws2, ws3, ... I suspect the sheets specified in the ranges are non on the same page and causing an error. See my comments below and my new code. I put the destination sheet in only one place in the code so you only have to make one change when going from one module to a 2nd module. Set wksPasteTo = Sheets("Closed_Requests") Remove Line - No need to select --------------------------------------- Sheets("Closed_Requests").Select ----------------------------------- 'ActiveSheet.Unprotect pw Add sheet reference ------------------------------------------------ from LR = Range("B" & Rows.Count).End(xlUp).Row to LR = wksPasteTo.Range("B" & Rows.Count).End(xlUp).Row ------------------------------------------------- Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) move inside with and add page reference ------------------------------------------------- Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row ------------------------------------------------- With Sheets("Distribution") ------------------------------------------------- from LastRow = Range("A65536").End(xlUp).Row to LastRow = .Range("A65536").End(xlUp).Row ------------------------------------------ For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then add sheet reference ------------------------------------------ from Range("B" & x).EntireRow.Copy to .Range("B" & x).EntireRow.Copy ------------------------------------------ Don't need with - sheet already specified in range above With Sheets("Closed_Requests") rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End With remove sheet refernce - already in with ------------------------------------------ from Sheets("Distribution").Range("B" & x).EntireRow.Delete to .Range("B" & x).EntireRow.Delete ------------------------------------------ End If Next x End With New Code Set wksPasteTo = Sheets("Closed_Requests") with wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) with Sheets("Distribution") LastRow = .Range("A65536").End(xlUp).Row For x = LastRow To 1 Step -1 If .Range("B" & x).Value = "Closed" Then .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) .Range("B" & x).EntireRow.Delete End If Next x End With "drewship" wrote: Thanks!! That works for the first part of my question. For the second part, I have tried: With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3").PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range.PasteSpecial Paste:=xlPasteValues("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").PasteSpecial Paste:=xlPasteValues.Range("A3") With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Cells("A3").PasteSpecial Paste:=xlPasteValues and probably a couple more. I have 6 report modules based on this code which I think is bloating the spreadsheet with unnessary code copied with the data. I would guess that it is erroring out because of the .Range() but that is only a guess. Thoughts on how to modify this to work? Thanks again!! Andrew "Joel" wrote: I see what was wrong. wksPasteTo is a worksheet object and rngPasteTo is a range object. originally from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues correction from wksPasteTo.Paste rngPasteTo to rngPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Thanks for replying Joel. I tried that but the Paste:= is hilighted and a 'Compile error: Named argument not found' is displayed. Do I need to DIM 'Paste:=xlPasteValues', or part of it ? The variable 'rngPasteTo' is the cell location for the row to be pasted and I can not figure out how to meld it into 'wksPasteTo.PasteSpecial Paste:=xlPasteValues' without getting an error. "Joel" wrote: mke this change from wksPasteTo.Paste rngPasteTo to wksPasteTo.PasteSpecial Paste:=xlPasteValues "drewship" wrote: Hello all. I have a module with the following code snippet I have been trying to modify: Set wksPasteTo = Sheets("Closed_Requests") |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
I apologise for not including the complete code...I am never sure how much
code is enough...or too much. The complete code for the Case block is below with "Sheets("All_Report").Activate" setting the active sheet...at least that is how I understood it: 'format and review new report Sheets("All_Report").Activate Range("N1") = Format(lodate, "M/D/YYYY") Range("O1") = Format(hidate, "M/D/YYYY") Columns("C:D").Select Selection.NumberFormat = "m/d/yyyy" Columns("A:Q").Columns.AutoFit LR = Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To LR If Not IsEmpty(Cells(i, "B")) Then Select Case Destination.Cells(i, "B").Value Case "Complete" icolor = 10 fcolor = 2 Case "In Progress" icolor = 8 Case "Items On Order" icolor = 6 Case "Researching" icolor = 3 fcolor = 2 Case "Closed" icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Destination.Cells(i, "B") .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With End If fcolor = xlColorIndexAutomatic Next i Range("A3").Select I am looking at the rest of your reply.... "Joel" wrote: the following code sets th elast line ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row It is taking the last line of data in column C. Rows.count is the last row of the worksheet (65536). the XL commands can be duplicated using the keyboardf xlup - Shift-Cntl - Up Arrow xldown - Shift-Cntl - Down Arrow xltoleft - Shift-Cntl - left Arrow xlright - Shift-Cntl - right Arrow So if you select cell C100 with mouse and press the keys Shft-Cntl and then the up arrow you will get the last row of data. the new code you posted in the Cae Select aren't referencing a workshet. they are using the active worksheet which I can't tell which worksheet is the active worksheet. You should always specify a worksheet to prevent errors in the code like the first part of the code that has a "With wksPasteTo". the all the RANGE statement with a period in front is automatically using the worksheet wksPasteTo. the code in the select statement has Range without the period in front so I can't tell which is the active worksheet. "drewship" wrote: Below is the working code to change the colors of the Status cells so all that is left for the moment is to figure out why the merged code is starting the paste on line 32. Hopefully you or someone else can help with that. I have tried steppiing through the code but can't see the problem: LR = Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To LR If Not IsEmpty(Cells(i, "B")) Then Select Case Destination.Cells(i, "B").Value Case "Complete" icolor = 10 fcolor = 2 Case "In Progress" icolor = 8 Case "Items On Order" icolor = 6 Case "Researching" icolor = 3 fcolor = 2 Case "Closed" icolor = 5 fcolor = 2 Case "" icolor = 2 ' Case Else: icolor = 0 End Select With Destination.Cells(i, "B") .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With End If fcolor = xlColorIndexAutomatic Next i Thanks!! Andrew "drewship" wrote: Thanks Joel!! I took what you provided and made some modifications so it would work in a manner I needed. ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A3" & (LR + 1)) With Sheets("Distribution") 'LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row LastRow = .Range("C65536").End(xlUp).Row ' For x = LastRow To 1 Step -1 For x = 3 To LastRow ' If .Range("B" & x).Value = "Closed" Then If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then RowsWithNumbers.EntireRow.Copy ' .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End If ' Next x End With End With There are 2 things that need some work. This code block in itself now pastes the rows starting at row 32 on the temporary sheet "wksPasteTo". Still trying to figure that out, but as a temporary workaround, I have added the following code to delete the blank lines before the rows are copied to the actual report: ' Delets blank rows Cells.Select On Error GoTo Exits: If Selection.Rows.Count 1 Then Set rng = Selection Else Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLast Cell).Row())) End If RwCnt = 0 For Rw = rng.Rows.Count To 1 Step -1 If Application.WorksheetFunction.CountA(rng.Rows(Rw). EntireRow) = 0 Then rng.Rows(Rw).EntireRow.Delete RwCnt = RwCnt + 1 End If Next Rw Exits: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Although this works, it increases processing time for the report. The last thing I need is to change the color of the status cells (column B) based on their content. In another sheets code, I have the following block I think could be reworked for my need: If Not Intersect(Target, Range("B:B")) Is Nothing Then Select Case Target.Value Case "Complete" If Cells(Target.Row, "D").Value < "" Then If MsgBox("Completion Date already exists. Update the date to today?", vbYesNo + vbQuestion) = vbNo Then GoTo ExitPoint End If Cells(Target.Row, "D").Value = Date icolor = 10 fcolor = 2 Case "In Progress" Cells(Target.Row, "D").Value = "" icolor = 8 Case "Items On Order" Cells(Target.Row, "D").Value = "" icolor = 6 Case "Researching" Cells(Target.Row, "D").Value = "" icolor = 3 fcolor = 2 Case "Closed" Cells(Target.Row, "D").Value = Cells(Target.Row, "D") icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Target .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With ActiveSheet.Protect pw, UserInterfaceOnly:=True End If Target row D is a date field I do not need in this use of Case, so I am looking for a way to get this to work. Is there an easier way? Thoughts?? Thanks again!!!! "Joel" wrote: You didn't specify the error you are getting. I don't know wherre you are decaring ws2, ws3, ... I suspect the sheets specified in the ranges are non on the same page and causing an error. See my comments below and my new code. I put the destination sheet in only one place in the code so you only have to make one change when going from one module to a 2nd module. Set wksPasteTo = Sheets("Closed_Requests") Remove Line - No need to select --------------------------------------- Sheets("Closed_Requests").Select ----------------------------------- 'ActiveSheet.Unprotect pw Add sheet reference ------------------------------------------------ from LR = Range("B" & Rows.Count).End(xlUp).Row to LR = wksPasteTo.Range("B" & Rows.Count).End(xlUp).Row ------------------------------------------------- Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) move inside with and add page reference ------------------------------------------------- Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row ------------------------------------------------- With Sheets("Distribution") ------------------------------------------------- from LastRow = Range("A65536").End(xlUp).Row to LastRow = .Range("A65536").End(xlUp).Row ------------------------------------------ For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then add sheet reference ------------------------------------------ from Range("B" & x).EntireRow.Copy to .Range("B" & x).EntireRow.Copy ------------------------------------------ Don't need with - sheet already specified in range above With Sheets("Closed_Requests") rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End With remove sheet refernce - already in with ------------------------------------------ from Sheets("Distribution").Range("B" & x).EntireRow.Delete to .Range("B" & x).EntireRow.Delete ------------------------------------------ End If Next x End With New Code Set wksPasteTo = Sheets("Closed_Requests") with wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) with Sheets("Distribution") LastRow = .Range("A65536").End(xlUp).Row For x = LastRow To 1 Step -1 If .Range("B" & x).Value = "Closed" Then .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) .Range("B" & x).EntireRow.Delete End If Next x End With "drewship" wrote: Thanks!! That works for the first part of my question. For the second part, I have tried: With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3").PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") PasteSpecial Paste:=xlPasteValues |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
Ok...not sure why removing the header lines (only 2 lines) made a difference,
but after I commented out the Delete Blank Rows code block, it works correctly, and quickly. Thank you very much for your help!! Merging my code with yours will make it easier to make changes and additions in the future and hopefully reduce spreadsheet bloat due to unneeded code in the reports. Andrew "Joel" wrote: the following code sets th elast line ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row It is taking the last line of data in column C. Rows.count is the last row of the worksheet (65536). the XL commands can be duplicated using the keyboardf xlup - Shift-Cntl - Up Arrow xldown - Shift-Cntl - Down Arrow xltoleft - Shift-Cntl - left Arrow xlright - Shift-Cntl - right Arrow So if you select cell C100 with mouse and press the keys Shft-Cntl and then the up arrow you will get the last row of data. the new code you posted in the Cae Select aren't referencing a workshet. they are using the active worksheet which I can't tell which worksheet is the active worksheet. You should always specify a worksheet to prevent errors in the code like the first part of the code that has a "With wksPasteTo". the all the RANGE statement with a period in front is automatically using the worksheet wksPasteTo. the code in the select statement has Range without the period in front so I can't tell which is the active worksheet. "drewship" wrote: Below is the working code to change the colors of the Status cells so all that is left for the moment is to figure out why the merged code is starting the paste on line 32. Hopefully you or someone else can help with that. I have tried steppiing through the code but can't see the problem: LR = Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To LR If Not IsEmpty(Cells(i, "B")) Then Select Case Destination.Cells(i, "B").Value Case "Complete" icolor = 10 fcolor = 2 Case "In Progress" icolor = 8 Case "Items On Order" icolor = 6 Case "Researching" icolor = 3 fcolor = 2 Case "Closed" icolor = 5 fcolor = 2 Case "" icolor = 2 ' Case Else: icolor = 0 End Select With Destination.Cells(i, "B") .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With End If fcolor = xlColorIndexAutomatic Next i Thanks!! Andrew "drewship" wrote: Thanks Joel!! I took what you provided and made some modifications so it would work in a manner I needed. ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A3" & (LR + 1)) With Sheets("Distribution") 'LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row LastRow = .Range("C65536").End(xlUp).Row ' For x = LastRow To 1 Step -1 For x = 3 To LastRow ' If .Range("B" & x).Value = "Closed" Then If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then RowsWithNumbers.EntireRow.Copy ' .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End If ' Next x End With End With There are 2 things that need some work. This code block in itself now pastes the rows starting at row 32 on the temporary sheet "wksPasteTo". Still trying to figure that out, but as a temporary workaround, I have added the following code to delete the blank lines before the rows are copied to the actual report: ' Delets blank rows Cells.Select On Error GoTo Exits: If Selection.Rows.Count 1 Then Set rng = Selection Else Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLast Cell).Row())) End If RwCnt = 0 For Rw = rng.Rows.Count To 1 Step -1 If Application.WorksheetFunction.CountA(rng.Rows(Rw). EntireRow) = 0 Then rng.Rows(Rw).EntireRow.Delete RwCnt = RwCnt + 1 End If Next Rw Exits: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Although this works, it increases processing time for the report. The last thing I need is to change the color of the status cells (column B) based on their content. In another sheets code, I have the following block I think could be reworked for my need: If Not Intersect(Target, Range("B:B")) Is Nothing Then Select Case Target.Value Case "Complete" If Cells(Target.Row, "D").Value < "" Then If MsgBox("Completion Date already exists. Update the date to today?", vbYesNo + vbQuestion) = vbNo Then GoTo ExitPoint End If Cells(Target.Row, "D").Value = Date icolor = 10 fcolor = 2 Case "In Progress" Cells(Target.Row, "D").Value = "" icolor = 8 Case "Items On Order" Cells(Target.Row, "D").Value = "" icolor = 6 Case "Researching" Cells(Target.Row, "D").Value = "" icolor = 3 fcolor = 2 Case "Closed" Cells(Target.Row, "D").Value = Cells(Target.Row, "D") icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Target .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With ActiveSheet.Protect pw, UserInterfaceOnly:=True End If Target row D is a date field I do not need in this use of Case, so I am looking for a way to get this to work. Is there an easier way? Thoughts?? Thanks again!!!! "Joel" wrote: You didn't specify the error you are getting. I don't know wherre you are decaring ws2, ws3, ... I suspect the sheets specified in the ranges are non on the same page and causing an error. See my comments below and my new code. I put the destination sheet in only one place in the code so you only have to make one change when going from one module to a 2nd module. Set wksPasteTo = Sheets("Closed_Requests") Remove Line - No need to select --------------------------------------- Sheets("Closed_Requests").Select ----------------------------------- 'ActiveSheet.Unprotect pw Add sheet reference ------------------------------------------------ from LR = Range("B" & Rows.Count).End(xlUp).Row to LR = wksPasteTo.Range("B" & Rows.Count).End(xlUp).Row ------------------------------------------------- Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) move inside with and add page reference ------------------------------------------------- Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row ------------------------------------------------- With Sheets("Distribution") ------------------------------------------------- from LastRow = Range("A65536").End(xlUp).Row to LastRow = .Range("A65536").End(xlUp).Row ------------------------------------------ For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then add sheet reference ------------------------------------------ from Range("B" & x).EntireRow.Copy to .Range("B" & x).EntireRow.Copy ------------------------------------------ Don't need with - sheet already specified in range above With Sheets("Closed_Requests") rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End With remove sheet refernce - already in with ------------------------------------------ from Sheets("Distribution").Range("B" & x).EntireRow.Delete to .Range("B" & x).EntireRow.Delete ------------------------------------------ End If Next x End With New Code Set wksPasteTo = Sheets("Closed_Requests") with wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) with Sheets("Distribution") LastRow = .Range("A65536").End(xlUp).Row For x = LastRow To 1 Step -1 If .Range("B" & x).Value = "Closed" Then .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) .Range("B" & x).EntireRow.Delete End If Next x End With "drewship" wrote: Thanks!! That works for the first part of my question. For the second part, I have tried: With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3").PasteSpecial Paste:=xlPasteValues With ws2 .Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("All_Report").Range("A3") PasteSpecial Paste:=xlPasteValues |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
I re-wrote the code the way I usually write my code. I can see you use
recorded to get some of your code. Inever use the recorded code directly. I always modify the recorded code. some time it is quicker for me to use the recorded but I I avoi using the select method in my macros unless excel only except the method with the select. Looking at the modified code I found your problem. Half you code is working with one worksheet and the other half with a different worksheet. You need to be using only one worksheet in this macro. with Sheets("All_Report") .Range("N1") = Format(lodate, "M/D/YYYY") .Range("O1") = Format(hidate, "M/D/YYYY") .Columns("C:D").NumberFormat = "m/d/yyyy" .Columns("A:Q").Columns.AutoFit LR = .Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To LR If Not IsEmpty(.Cells(i, "B")) Then Select Case Destination.Cells(i, "B").Value Case "Complete" icolor = 10 fcolor = 2 Case "In Progress" icolor = 8 Case "Items On Order" icolor = 6 Case "Researching" icolor = 3 fcolor = 2 Case "Closed" icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Destination.Cells(i, "B") .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With End If fcolor = xlColorIndexAutomatic Next i Range("A3").Select end with "drewship" wrote: Ok...not sure why removing the header lines (only 2 lines) made a difference, but after I commented out the Delete Blank Rows code block, it works correctly, and quickly. Thank you very much for your help!! Merging my code with yours will make it easier to make changes and additions in the future and hopefully reduce spreadsheet bloat due to unneeded code in the reports. Andrew "Joel" wrote: the following code sets th elast line ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row It is taking the last line of data in column C. Rows.count is the last row of the worksheet (65536). the XL commands can be duplicated using the keyboardf xlup - Shift-Cntl - Up Arrow xldown - Shift-Cntl - Down Arrow xltoleft - Shift-Cntl - left Arrow xlright - Shift-Cntl - right Arrow So if you select cell C100 with mouse and press the keys Shft-Cntl and then the up arrow you will get the last row of data. the new code you posted in the Cae Select aren't referencing a workshet. they are using the active worksheet which I can't tell which worksheet is the active worksheet. You should always specify a worksheet to prevent errors in the code like the first part of the code that has a "With wksPasteTo". the all the RANGE statement with a period in front is automatically using the worksheet wksPasteTo. the code in the select statement has Range without the period in front so I can't tell which is the active worksheet. "drewship" wrote: Below is the working code to change the colors of the Status cells so all that is left for the moment is to figure out why the merged code is starting the paste on line 32. Hopefully you or someone else can help with that. I have tried steppiing through the code but can't see the problem: LR = Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To LR If Not IsEmpty(Cells(i, "B")) Then Select Case Destination.Cells(i, "B").Value Case "Complete" icolor = 10 fcolor = 2 Case "In Progress" icolor = 8 Case "Items On Order" icolor = 6 Case "Researching" icolor = 3 fcolor = 2 Case "Closed" icolor = 5 fcolor = 2 Case "" icolor = 2 ' Case Else: icolor = 0 End Select With Destination.Cells(i, "B") .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With End If fcolor = xlColorIndexAutomatic Next i Thanks!! Andrew "drewship" wrote: Thanks Joel!! I took what you provided and made some modifications so it would work in a manner I needed. ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A3" & (LR + 1)) With Sheets("Distribution") 'LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row LastRow = .Range("C65536").End(xlUp).Row ' For x = LastRow To 1 Step -1 For x = 3 To LastRow ' If .Range("B" & x).Value = "Closed" Then If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then RowsWithNumbers.EntireRow.Copy ' .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End If ' Next x End With End With There are 2 things that need some work. This code block in itself now pastes the rows starting at row 32 on the temporary sheet "wksPasteTo". Still trying to figure that out, but as a temporary workaround, I have added the following code to delete the blank lines before the rows are copied to the actual report: ' Delets blank rows Cells.Select On Error GoTo Exits: If Selection.Rows.Count 1 Then Set rng = Selection Else Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLast Cell).Row())) End If RwCnt = 0 For Rw = rng.Rows.Count To 1 Step -1 If Application.WorksheetFunction.CountA(rng.Rows(Rw). EntireRow) = 0 Then rng.Rows(Rw).EntireRow.Delete RwCnt = RwCnt + 1 End If Next Rw Exits: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Although this works, it increases processing time for the report. The last thing I need is to change the color of the status cells (column B) based on their content. In another sheets code, I have the following block I think could be reworked for my need: If Not Intersect(Target, Range("B:B")) Is Nothing Then Select Case Target.Value Case "Complete" If Cells(Target.Row, "D").Value < "" Then If MsgBox("Completion Date already exists. Update the date to today?", vbYesNo + vbQuestion) = vbNo Then GoTo ExitPoint End If Cells(Target.Row, "D").Value = Date icolor = 10 fcolor = 2 Case "In Progress" Cells(Target.Row, "D").Value = "" icolor = 8 Case "Items On Order" Cells(Target.Row, "D").Value = "" icolor = 6 Case "Researching" Cells(Target.Row, "D").Value = "" icolor = 3 fcolor = 2 Case "Closed" Cells(Target.Row, "D").Value = Cells(Target.Row, "D") icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Target .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With ActiveSheet.Protect pw, UserInterfaceOnly:=True End If Target row D is a date field I do not need in this use of Case, so I am looking for a way to get this to work. Is there an easier way? Thoughts?? Thanks again!!!! "Joel" wrote: You didn't specify the error you are getting. I don't know wherre you are decaring ws2, ws3, ... I suspect the sheets specified in the ranges are non on the same page and causing an error. See my comments below and my new code. I put the destination sheet in only one place in the code so you only have to make one change when going from one module to a 2nd module. Set wksPasteTo = Sheets("Closed_Requests") Remove Line - No need to select --------------------------------------- Sheets("Closed_Requests").Select ----------------------------------- 'ActiveSheet.Unprotect pw Add sheet reference ------------------------------------------------ from LR = Range("B" & Rows.Count).End(xlUp).Row to LR = wksPasteTo.Range("B" & Rows.Count).End(xlUp).Row ------------------------------------------------- Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) move inside with and add page reference ------------------------------------------------- Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row ------------------------------------------------- With Sheets("Distribution") ------------------------------------------------- from LastRow = Range("A65536").End(xlUp).Row to LastRow = .Range("A65536").End(xlUp).Row ------------------------------------------ For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then add sheet reference ------------------------------------------ from Range("B" & x).EntireRow.Copy to .Range("B" & x).EntireRow.Copy ------------------------------------------ Don't need with - sheet already specified in range above With Sheets("Closed_Requests") rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End With remove sheet refernce - already in with ------------------------------------------ from Sheets("Distribution").Range("B" & x).EntireRow.Delete to .Range("B" & x).EntireRow.Delete ------------------------------------------ End If Next x End With New Code Set wksPasteTo = Sheets("Closed_Requests") with wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("B" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) with Sheets("Distribution") LastRow = .Range("A65536").End(xlUp).Row For x = LastRow To 1 Step -1 If .Range("B" & x).Value = "Closed" Then .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) .Range("B" & x).EntireRow.Delete End If Next x End With "drewship" wrote: |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy entire row and paste values only to another sheet
I am not very good writing the code myself so I use the wizaeds to get me
started then try to modify them for my purposes. In this case I think I confused myself a bit. Thanks for all your help!! The code is perfect!! Andrew "Joel" wrote: I re-wrote the code the way I usually write my code. I can see you use recorded to get some of your code. Inever use the recorded code directly. I always modify the recorded code. some time it is quicker for me to use the recorded but I I avoi using the select method in my macros unless excel only except the method with the select. Looking at the modified code I found your problem. Half you code is working with one worksheet and the other half with a different worksheet. You need to be using only one worksheet in this macro. with Sheets("All_Report") .Range("N1") = Format(lodate, "M/D/YYYY") .Range("O1") = Format(hidate, "M/D/YYYY") .Columns("C:D").NumberFormat = "m/d/yyyy" .Columns("A:Q").Columns.AutoFit LR = .Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To LR If Not IsEmpty(.Cells(i, "B")) Then Select Case Destination.Cells(i, "B").Value Case "Complete" icolor = 10 fcolor = 2 Case "In Progress" icolor = 8 Case "Items On Order" icolor = 6 Case "Researching" icolor = 3 fcolor = 2 Case "Closed" icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Destination.Cells(i, "B") .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With End If fcolor = xlColorIndexAutomatic Next i Range("A3").Select end with "drewship" wrote: Ok...not sure why removing the header lines (only 2 lines) made a difference, but after I commented out the Delete Blank Rows code block, it works correctly, and quickly. Thank you very much for your help!! Merging my code with yours will make it easier to make changes and additions in the future and hopefully reduce spreadsheet bloat due to unneeded code in the reports. Andrew "Joel" wrote: the following code sets th elast line ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row It is taking the last line of data in column C. Rows.count is the last row of the worksheet (65536). the XL commands can be duplicated using the keyboardf xlup - Shift-Cntl - Up Arrow xldown - Shift-Cntl - Down Arrow xltoleft - Shift-Cntl - left Arrow xlright - Shift-Cntl - right Arrow So if you select cell C100 with mouse and press the keys Shft-Cntl and then the up arrow you will get the last row of data. the new code you posted in the Cae Select aren't referencing a workshet. they are using the active worksheet which I can't tell which worksheet is the active worksheet. You should always specify a worksheet to prevent errors in the code like the first part of the code that has a "With wksPasteTo". the all the RANGE statement with a period in front is automatically using the worksheet wksPasteTo. the code in the select statement has Range without the period in front so I can't tell which is the active worksheet. "drewship" wrote: Below is the working code to change the colors of the Status cells so all that is left for the moment is to figure out why the merged code is starting the paste on line 32. Hopefully you or someone else can help with that. I have tried steppiing through the code but can't see the problem: LR = Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To LR If Not IsEmpty(Cells(i, "B")) Then Select Case Destination.Cells(i, "B").Value Case "Complete" icolor = 10 fcolor = 2 Case "In Progress" icolor = 8 Case "Items On Order" icolor = 6 Case "Researching" icolor = 3 fcolor = 2 Case "Closed" icolor = 5 fcolor = 2 Case "" icolor = 2 ' Case Else: icolor = 0 End Select With Destination.Cells(i, "B") .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With End If fcolor = xlColorIndexAutomatic Next i Thanks!! Andrew "drewship" wrote: Thanks Joel!! I took what you provided and made some modifications so it would work in a manner I needed. ' Set wksPasteTo = Sheets("AllName1") set prior to this code block With wksPasteTo 'ActiveSheet.Unprotect pw LR = .Range("C" & Rows.Count).End(xlUp).Row Set rngPasteTo = wksPasteTo.Range("A3" & (LR + 1)) With Sheets("Distribution") 'LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row LastRow = .Range("C65536").End(xlUp).Row ' For x = LastRow To 1 Step -1 For x = 3 To LastRow ' If .Range("B" & x).Value = "Closed" Then If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value < "" And .Cells(x, "C").Value = lodate And .Cells(x, "C").Value <= hidate Then If RowsWithNumbers Is Nothing Then Set RowsWithNumbers = .Cells(x, "C") Else Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C")) End If End If Next If Not RowsWithNumbers Is Nothing Then RowsWithNumbers.EntireRow.Copy ' .Range("B" & x).EntireRow.Copy rngPasteTo.PasteSpecial Paste:=xlPasteValues Set rngPasteTo = rngPasteTo.Offset(1) End If ' Next x End With End With There are 2 things that need some work. This code block in itself now pastes the rows starting at row 32 on the temporary sheet "wksPasteTo". Still trying to figure that out, but as a temporary workaround, I have added the following code to delete the blank lines before the rows are copied to the actual report: ' Delets blank rows Cells.Select On Error GoTo Exits: If Selection.Rows.Count 1 Then Set rng = Selection Else Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLast Cell).Row())) End If RwCnt = 0 For Rw = rng.Rows.Count To 1 Step -1 If Application.WorksheetFunction.CountA(rng.Rows(Rw). EntireRow) = 0 Then rng.Rows(Rw).EntireRow.Delete RwCnt = RwCnt + 1 End If Next Rw Exits: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Although this works, it increases processing time for the report. The last thing I need is to change the color of the status cells (column B) based on their content. In another sheets code, I have the following block I think could be reworked for my need: If Not Intersect(Target, Range("B:B")) Is Nothing Then Select Case Target.Value Case "Complete" If Cells(Target.Row, "D").Value < "" Then If MsgBox("Completion Date already exists. Update the date to today?", vbYesNo + vbQuestion) = vbNo Then GoTo ExitPoint End If Cells(Target.Row, "D").Value = Date icolor = 10 fcolor = 2 Case "In Progress" Cells(Target.Row, "D").Value = "" icolor = 8 Case "Items On Order" Cells(Target.Row, "D").Value = "" icolor = 6 Case "Researching" Cells(Target.Row, "D").Value = "" icolor = 3 fcolor = 2 Case "Closed" Cells(Target.Row, "D").Value = Cells(Target.Row, "D") icolor = 5 fcolor = 2 Case "" icolor = 2 End Select With Target .Interior.ColorIndex = icolor .Font.ColorIndex = fcolor End With ActiveSheet.Protect pw, UserInterfaceOnly:=True End If Target row D is a date field I do not need in this use of Case, so I am looking for a way to get this to work. Is there an easier way? Thoughts?? Thanks again!!!! "Joel" wrote: You didn't specify the error you are getting. I don't know wherre you are decaring ws2, ws3, ... I suspect the sheets specified in the ranges are non on the same page and causing an error. See my comments below and my new code. I put the destination sheet in only one place in the code so you only have to make one change when going from one module to a 2nd module. Set wksPasteTo = Sheets("Closed_Requests") Remove Line - No need to select --------------------------------------- Sheets("Closed_Requests").Select ----------------------------------- 'ActiveSheet.Unprotect pw Add sheet reference ------------------------------------------------ from LR = Range("B" & Rows.Count).End(xlUp).Row to LR = wksPasteTo.Range("B" & Rows.Count).End(xlUp).Row ------------------------------------------------- Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1)) move inside with and add page reference ------------------------------------------------- Sheets("Distribution").Select LastRow = Range("A65536").End(xlUp).Row ------------------------------------------------- With Sheets("Distribution") ------------------------------------------------- from LastRow = Range("A65536").End(xlUp).Row to LastRow = .Range("A65536").End(xlUp).Row ------------------------------------------ For x = LastRow To 1 Step -1 If Range("B" & x).Value = "Closed" Then add sheet reference |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Use loop to filter, copy/paste to new sheet; run through entire li | Excel Programming | |||
If Font.ColorIndex = 3, Copy Entire Row and Paste to New Sheet | Excel Programming | |||
Find Multiple Values, Copy Entire Row & Paste | Excel Programming | |||
Copy Paste Values - Entire Workbook and Save | Excel Discussion (Misc queries) | |||
Macro - copy entire row and paste at bottom of another sheet | Excel Programming |