#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2
Default Copy rows

I'm trying to write a macro, that copy rows from sheet 2 to sheet 1
and the criteria for the rows in sheet 2 comes from sheet 3.
I'm very new to VBA, so I'm trying to piece different macros
together but can't get to do right.

Example:
Sheet 3 (performance sheet)
Stock no. 10 20 24 30
No. sold

Sheet 2 (inventory list)
Stock no. amount on stock. Amount sold
10 10 0
11 5 5
20 3 5
21 2 3
24 9 1
30 1 2
35 10 2

Result:
sheet 1
Stock no. amount on stock. Amount sold
10 5 5
20 3 5
24 9 1
30 1 2

I have a macro that kind of works, but it is very slow and if a number
doesn't exist in sheet 1, it stops with an error.
The numbers of criterias in sheet 3 varies so I need a loop, that runs
x numbers of time.

Could anyone help me please ?

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2
Default Copy rows

I have used the macro from http://www.rondebruin.nl/copy5.htm added a
loop macro

Sub makro()
' This sub use the function LastRow
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim str As Long

Set WS1 = Sheets("Ark2") '<<< Change
Set WS2 = Sheets("Ark1") '<<< Change
Set WS3 = Sheets("Ark3") '<<< Change
Set rng1 = WS1.Range("A1").CurrentRegion '<<< Change 'A1 is the
top left cell of your filter range and the header of the first column

Range("B7").Select
' loop
Dim CountA As Range
Set CountA = WS3.Range("G2")

l_loop = 0
Do Until l_loop = CountA
l_loop = l_loop + 1

Sheets("ark3").Select
ActiveCell(1, 2).Select '<<< NExt column

str = ActiveCell.Value

'Close Auto
WS1.AutoFilterMode = False

'This example filter on the first column in the range (change the
field if needed)
rng1.AutoFilter Field:=1, Criteria1:=str, Operator:=xlOr

With WS1.AutoFilter.Range
On Error Resume Next
' This example will not copy the header row
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1,
..Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
'Copy the cells
rng2.Copy WS2.Range("A" & LastRow(WS2) + 1)
'Delete the rows in WS1
rng2.EntireRow.Delete

End If
End With
WS1.AutoFilterMode = False

Loop


End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

On Error GoTo 0
End Function

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do I Copy and Paste onto Same Rows after filtering out rows. TWT Excel Discussion (Misc queries) 2 October 20th 08 04:09 PM
Copy rows from one worksheet automatically, ignore rows that are b Kris Excel Worksheet Functions 2 October 10th 08 09:28 PM
Copy rows of data (eliminating blank rows) from fixed layout Sweepea Excel Discussion (Misc queries) 1 March 13th 07 11:05 PM
Hide Rows - copy and paste only rows that show Access101 Excel Worksheet Functions 3 March 1st 06 12:39 AM
Copy Rows and insert these rows before a page break AQ Mahomed Excel Programming 0 June 8th 04 09:09 AM


All times are GMT +1. The time now is 09:52 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"