Pimo
01-14-2021, 07:51 PM
Hi!
I have a problem with macro running too slow and I guess it is just because of lack of my knowledge.
I have a macro that is copying data from "database" and paste it to another sheet.
Macro is taking the names from the list in Sheet1 and looks for matches in Sheet2. When the match is found is copying a specific cell.
Right now I have a macro for each person on the list so I have 5 the same macros doing the same thing so maybe that why it takes so much time....
Is there any way to make it faster?
below my code so far and sample sheet
Sub CopySalesMan1()
Dim lastrow As Long, erow As Long
lastrow = Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lastrow
If Worksheets("Sheet2").Cells(i, 25).Value = Worksheets("Sheet1").Cells(6, 12).Value Then
Worksheets("Sheet2").Cells(i, 2).Copy
erow = Worksheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row
Worksheets("Sheet1").Cells(erow + 1, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 25).Copy
Worksheets("Sheet1").Cells(erow + 1, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 3).Copy
Worksheets("Sheet1").Cells(erow + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 4).Copy
Worksheets("Sheet1").Cells(erow + 1, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 5).Copy
Worksheets("Sheet1").Cells(erow + 1, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 6).Copy
Worksheets("Sheet1").Cells(erow + 1, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 21).Copy
Worksheets("Sheet1").Cells(erow + 1, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next i
End Sub
Sub All()
If Worksheets("Sheet1").Range("L7").Value <> "" Then Call CopySalesMan2
If Worksheets("Sheet1").Range("L8").Value <> "" Then Call CopySalesMan3
If Worksheets("Sheet1").Range("L9").Value <> "" Then Call CopySalesMan4
If Worksheets("Sheet1").Range("L10").Value <> "" Then Call CopySalesMan5
End Sub
27731
I have a problem with macro running too slow and I guess it is just because of lack of my knowledge.
I have a macro that is copying data from "database" and paste it to another sheet.
Macro is taking the names from the list in Sheet1 and looks for matches in Sheet2. When the match is found is copying a specific cell.
Right now I have a macro for each person on the list so I have 5 the same macros doing the same thing so maybe that why it takes so much time....
Is there any way to make it faster?
below my code so far and sample sheet
Sub CopySalesMan1()
Dim lastrow As Long, erow As Long
lastrow = Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lastrow
If Worksheets("Sheet2").Cells(i, 25).Value = Worksheets("Sheet1").Cells(6, 12).Value Then
Worksheets("Sheet2").Cells(i, 2).Copy
erow = Worksheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row
Worksheets("Sheet1").Cells(erow + 1, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 25).Copy
Worksheets("Sheet1").Cells(erow + 1, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 3).Copy
Worksheets("Sheet1").Cells(erow + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 4).Copy
Worksheets("Sheet1").Cells(erow + 1, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 5).Copy
Worksheets("Sheet1").Cells(erow + 1, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 6).Copy
Worksheets("Sheet1").Cells(erow + 1, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 21).Copy
Worksheets("Sheet1").Cells(erow + 1, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next i
End Sub
Sub All()
If Worksheets("Sheet1").Range("L7").Value <> "" Then Call CopySalesMan2
If Worksheets("Sheet1").Range("L8").Value <> "" Then Call CopySalesMan3
If Worksheets("Sheet1").Range("L9").Value <> "" Then Call CopySalesMan4
If Worksheets("Sheet1").Range("L10").Value <> "" Then Call CopySalesMan5
End Sub
27731