Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I Copy and Paste onto Same Rows after filtering out rows. | Excel Discussion (Misc queries) | |||
Copy rows from one worksheet automatically, ignore rows that are b | Excel Worksheet Functions | |||
Copy rows of data (eliminating blank rows) from fixed layout | Excel Discussion (Misc queries) | |||
Hide Rows - copy and paste only rows that show | Excel Worksheet Functions | |||
Copy Rows and insert these rows before a page break | Excel Programming |