Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Mercy - Need help with Copy/Paste VBA
My reverse engineering skills have finally failed me =(
I need to copy rows based on a set value in Column A, to a different worksheet and start on the next empty row. I also need to paste special as the values in the source sheet are generated via formulas. Sub CopySAP() RowCount = 2 With Worksheets("SAPUpload").Range("a3:a200") Set c = .Find("1", LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.EntireRow.Copy _ Destination:=Worksheets("SAPUpload2").Rows(RowCoun t) RowCount = RowCount + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Mercy - Need help with Copy/Paste VBA
Sub CopySAP()
RowCount = 2 With Worksheets("SAPUpload").Range("a3:a200") Set c = .Find("1", LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.EntireRow.Copy Worksheets("SAPUpload2").Rows(RowCount).PasteSpeci al _ paste:=xlpastevalues RowCount = RowCount + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With End Sub "AirgasRob" wrote: My reverse engineering skills have finally failed me =( I need to copy rows based on a set value in Column A, to a different worksheet and start on the next empty row. I also need to paste special as the values in the source sheet are generated via formulas. Sub CopySAP() RowCount = 2 With Worksheets("SAPUpload").Range("a3:a200") Set c = .Find("1", LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.EntireRow.Copy _ Destination:=Worksheets("SAPUpload2").Rows(RowCoun t) RowCount = RowCount + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Mercy - Need help with Copy/Paste VBA
Just a matter of personal preference but I prefer to do the paste in one
operation Sub copyit() Dim MyRange, MyRange1 As Range Dim Lastrow As Long For Each c In Sheets("SAPUpload").Range("A3:A200") If InStr(c.Value, 1) 0 Then If MyRange1 Is Nothing Then Set MyRange1 = c.EntireRow Else Set MyRange1 = Union(MyRange1, c.EntireRow) End If End If Next If Not MyRange1 Is Nothing Then MyRange1.Copy Lastrow = Sheets("SAPUpload2").Cells(Rows.Count, "H").End(xlUp).Row Sheets("SAPUpload2").Range("A" & Lastrow).PasteSpecial End If End Sub Mike "AirgasRob" wrote: My reverse engineering skills have finally failed me =( I need to copy rows based on a set value in Column A, to a different worksheet and start on the next empty row. I also need to paste special as the values in the source sheet are generated via formulas. Sub CopySAP() RowCount = 2 With Worksheets("SAPUpload").Range("a3:a200") Set c = .Find("1", LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.EntireRow.Copy _ Destination:=Worksheets("SAPUpload2").Rows(RowCoun t) RowCount = RowCount + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Mercy - Need help with Copy/Paste VBA
Just a matter of personal preference but I prefer to do the paste in one
operation And another point compared to your code (as corrected by Joel) my version runs ~10 times faster without the need to bounce back and forward doing individual paste operations. Mike "Mike H" wrote: Just a matter of personal preference but I prefer to do the paste in one operation Sub copyit() Dim MyRange, MyRange1 As Range Dim Lastrow As Long For Each c In Sheets("SAPUpload").Range("A3:A200") If InStr(c.Value, 1) 0 Then If MyRange1 Is Nothing Then Set MyRange1 = c.EntireRow Else Set MyRange1 = Union(MyRange1, c.EntireRow) End If End If Next If Not MyRange1 Is Nothing Then MyRange1.Copy Lastrow = Sheets("SAPUpload2").Cells(Rows.Count, "H").End(xlUp).Row Sheets("SAPUpload2").Range("A" & Lastrow).PasteSpecial End If End Sub Mike "AirgasRob" wrote: My reverse engineering skills have finally failed me =( I need to copy rows based on a set value in Column A, to a different worksheet and start on the next empty row. I also need to paste special as the values in the source sheet are generated via formulas. Sub CopySAP() RowCount = 2 With Worksheets("SAPUpload").Range("a3:a200") Set c = .Find("1", LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.EntireRow.Copy _ Destination:=Worksheets("SAPUpload2").Rows(RowCoun t) RowCount = RowCount + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Mercy - Need help with Copy/Paste VBA
Thanks Joel, as always I learn a little more everytime I come here. The code
works great with one exception. When I run the code a second time it overwrites what was previously pasted. "joel" wrote: Sub CopySAP() RowCount = 2 With Worksheets("SAPUpload").Range("a3:a200") Set c = .Find("1", LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.EntireRow.Copy Worksheets("SAPUpload2").Rows(RowCount).PasteSpeci al _ paste:=xlpastevalues RowCount = RowCount + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With End Sub "AirgasRob" wrote: My reverse engineering skills have finally failed me =( I need to copy rows based on a set value in Column A, to a different worksheet and start on the next empty row. I also need to paste special as the values in the source sheet are generated via formulas. Sub CopySAP() RowCount = 2 With Worksheets("SAPUpload").Range("a3:a200") Set c = .Find("1", LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.EntireRow.Copy _ Destination:=Worksheets("SAPUpload2").Rows(RowCoun t) RowCount = RowCount + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Mercy - Need help with Copy/Paste VBA
Mike thank you very much exactly what I was looking for. I only had to make a
few minor changes to get the exact results I wanted. I will post the modified code for those that may come after me. I made note of the two changes I had to make. Sub copyit() Dim MyRange, MyRange1 As Range Dim Lastrow As Long For Each c In Sheets("SAPUpload").Range("A3:A200") If InStr(c.Value, 1) 0 Then If MyRange1 Is Nothing Then Set MyRange1 = c.EntireRow Else Set MyRange1 = Union(MyRange1, c.EntireRow) End If End If Next If Not MyRange1 Is Nothing Then MyRange1.Copy Lastrow = Sheets("SAPUpload2").Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).Row '<--Added .Offset(1, 0) Sheets("SAPUpload2").Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues '<--Added Paste:=xlPasteValues End If End Sub "Mike H" wrote: Just a matter of personal preference but I prefer to do the paste in one operation Sub copyit() Dim MyRange, MyRange1 As Range Dim Lastrow As Long For Each c In Sheets("SAPUpload").Range("A3:A200") If InStr(c.Value, 1) 0 Then If MyRange1 Is Nothing Then Set MyRange1 = c.EntireRow Else Set MyRange1 = Union(MyRange1, c.EntireRow) End If End If Next If Not MyRange1 Is Nothing Then MyRange1.Copy Lastrow = Sheets("SAPUpload2").Cells(Rows.Count, "H").End(xlUp).Row Sheets("SAPUpload2").Range("A" & Lastrow).PasteSpecial End If End Sub Mike "AirgasRob" wrote: My reverse engineering skills have finally failed me =( I need to copy rows based on a set value in Column A, to a different worksheet and start on the next empty row. I also need to paste special as the values in the source sheet are generated via formulas. Sub CopySAP() RowCount = 2 With Worksheets("SAPUpload").Range("a3:a200") Set c = .Find("1", LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.EntireRow.Copy _ Destination:=Worksheets("SAPUpload2").Rows(RowCoun t) RowCount = RowCount + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Automating copy/paste/paste special when row references change | Excel Programming | |||
which line mercy script | Excel Discussion (Misc queries) | |||
help w/ generic copy & paste/paste special routine | Excel Programming | |||
Excel cut/Paste Problem: Year changes after data is copy and paste | Excel Discussion (Misc queries) | |||
Copy and Paste macro needs to paste to a changing cell reference | Excel Programming |