|
-
Aug 1st, 2011, 05:23 PM
#1
Thread Starter
New Member
making code more Efficient !!! please help
Hello,
I'm using this code to verify values, and copy cells from one sheet to another in the same workbook...... the code works fine. but is really slow and Inefficient.
can you help me make the code run better.
=================================================================
Sub CopyCells()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim j As Long
Dim i As Long
Dim c As Long
Dim c1 As Long
Dim c2 As Long
Dim c3 As Long
Dim lastrow1 As Long
Dim lastrow2 As Long
Set sh1 = Worksheets("Situacion Madera")
Set sh2 = Worksheets("Madera Pedida")
lastrow1 = 3
lastrow2 = sh2.Cells(Rows.Count, 3).End(xlUp).Row
For c = 2 To 563
c1 = c + 1
c2 = c + 2
c3 = c + 3
j = 3
For i = 5 To lastrow2
If sh1.Cells(2, c).Value <= sh2.Cells(i, 3).Value And _
sh1.Cells(2, c1).Value <= sh2.Cells(i, 4).Value And _
sh1.Cells(2, c2).Value <= sh2.Cells(i, 5).Value And _
sh1.Cells(2, c3).Value > 0 Then
j = j + 1
sh2.Select
Cells(i, 3).Select
Selection.Copy
sh1.Select
Cells(j, c).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh2.Select
Cells(i, 4).Select
Selection.Copy
sh1.Select
Cells(j, c1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh2.Select
Cells(i, 5).Select
Selection.Copy
sh1.Select
Cells(j, c2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh2.Select
Cells(i, 7).Select
Selection.Copy
sh1.Select
Cells(j, c3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next i
c = c + 10
Next c
End Sub
================================================================
Thanks
virgiliocabrera
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|