View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Gert-Jan Gert-Jan is offline
external usenet poster
 
Posts: 49
Default Copy rows with a specific value in column A

Hi,

Thanks again. Made your macro "working" (read: error-free) with this:

Sub Kopieren()
For i = 100 To 2 Step -1
With Sheets("Blad1")
Strval = .Range("C26")
dlr = Sheets("Blad2").Cells(Rows.Count, "a").End(xlUp).Row
If .Cells(i, "a") = Strval Then Sheets("Blad2").Rows(dlr).Value =
..Rows(i).Value
End With
Next i
End Sub

But it has the same problem: it only copies the first line of my range.


"Don Guillett" schreef in bericht
...
correct my typo so that str and strval are the same

for i 100 to 2 step-1
with sheets("sheet1")
str = .Range("C25")
dlr=sheets("dest").cells(rows.count,"a").end(xlup) .row
if .cells(i,"a")=str then sheets("dest").rows(dlr).value=.rows(i).value
next i
end with


--
Don Guillett
SalesAid Software

"Gert-Jan" wrote in message
...
Hi Don,

Thanks for responding. Unfortunally, it doesn´t work: on "Str" I got an
error.

Gert-Jan

"Don Guillett" schreef in bericht
...
I would suggest using datafilterautofilterfilter on your valuecopy
the
bunch at once but
something like this without selections or screen updating needed.
UNTESTED

for i 100 to 2 step-1
with sheets("sheet1")
str = .Range("C25")
dlr=sheets("dest").cells(rows.count,"a").end(xlup) .row
if .cells(i,"a")=strval then
sheets("dest").rows(dlr).value=.rows(i).value
next i
end with


--
Don Guillett
SalesAid Software

"Gert-Jan" wrote in message
...
Hi, this macro is supposed to copy all the rows with a specific value
(in
C25) to another sheet. But, only the first row will be copied. Can
someone help?? Or have a better suggestion??

Sub Copy()
Application.ScreenUpdating = False
With Sheets("Sheet1")
Dim i As Long, sTargetValue As String
sTargetValue = Sheets("Sheet1").Range("C25")
For i = 100 To 1 Step -1
If Cells(i, "A").Text = sTargetValue Then
Rows(i).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
End If
Next i
End With
End Sub