How to copy macro to other files

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I have created a test file with a macro which i want to use in other excel files also. I have to copy the test file and add it in another folder and renamed it. However, when i tried running the code in the new file by clicking on the button linked to the macro, it will run the macro and the results will appear in the new file but it will also open the test file at the same time. I don't want the test file to open when the code runs. Can anyone please advise why this is happening and how to stop the test file from opening?
I tried running the code step by step again by clicking F8 and the test file doesn't open in that case. But, when i click the button linked to the macro on the new file, the test file opens for some reason.
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
2,002
Office Version
  1. 2016
Platform
  1. Windows
It is probably your button code has line referring to the original test workbook name. Check if you have any workbook name in your code. Should have jusr referred to ActiveWorkbook or ThisWorkbook
 

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
It is probably your button code has line referring to the original test workbook name. Check if you have any workbook name in your code. Should have jusr referred to ActiveWorkbook or ThisWorkbook
Hi,

I have used the variable wb to get the active workbook in my code and the rest of the code uses this same variable.

Sub Price()

Dim pno As String
Dim LastRowinMainSheet As Long
Dim j As Integer
Dim i As Integer
Dim f As Workbook
Dim rgFound As Range
Dim lastrow As Long
Dim m As Integer
Dim lrow As Long
Dim pfind As Range
Dim wb As Workbook

Set wb = ActiveWorkbook

LastRowinMainSheet = wb.Worksheets(2).Range("E:E").Find(What:="*", _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lastrow = wb.Worksheets(2).Range("D:D").Find(What:="*", _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
If LastRowinMainSheet > lastrow Then
m = LastRowinMainSheet
Else
m = lastrow
End If
If sheetExists("Pricebook") = False Then
wb.Sheets.Add(After:=Sheets("Emerson COMMERCIAL OFFER")).name = "Pricebook"
Set f = Workbooks.Open("\\emrsn.org\VC-Drive_N\AEDU1_INSIDE_SALES\SPARES\Pricelist.xlsx", True, True)
f.Worksheets(1).Range("A1:U2").Copy
wb.Worksheets("Pricebook").Range("A1:U2").PasteSpecial (xlPasteAll)
For j = 24 To m
If IsEmpty(Cells(j, 7).Value) = True Then
If IsEmpty(Cells(j, 4).Value) = True Then
pno = wb.Worksheets(2).Cells(j, 5).Value
Set rgFound = f.Worksheets(1).Range("B:B").Find(What:=pno, LookIn:=xlValues, LookAt:=xlWhole)
If rgFound Is Nothing Then
wb.Worksheets(2).Cells(j, 7).Value = "P/N not found"
Else
wb.Worksheets(2).Cells(j, 4).Value = rgFound.Offset(0, 1).Value
wb.Worksheets(2).Cells(j, 6).Value = rgFound.Offset(0, 2).Value
wb.Worksheets(2).Cells(j, 7).Value = rgFound.Offset(0, 3).Value
wb.Worksheets(2).Cells(j, 12).Value = rgFound.Offset(0, 12).Value
rgFound.EntireRow.Copy
wb.Worksheets("Pricebook").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End If
Else
pno = wb.Worksheets(2).Cells(j, 4).Value
Set rgFound = f.Worksheets(1).Range("C:C").Find(What:=pno, LookIn:=xlValues, LookAt:=xlWhole)
If rgFound Is Nothing Then
wb.Worksheets(2).Cells(j, 7).Value = "P/N not found"
Else
wb.Worksheets(2).Cells(j, 5).Value = rgFound.Offset(0, -1).Value
wb.Worksheets(2).Cells(j, 6).Value = rgFound.Offset(0, 1).Value
wb.Worksheets(2).Cells(j, 7).Value = rgFound.Offset(0, 2).Value
wb.Worksheets(2).Cells(j, 12).Value = rgFound.Offset(0, 11).Value
rgFound.EntireRow.Copy
wb.Worksheets("Pricebook").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End If
End If
End If
Next j
Else
Set f = Workbooks.Open("\\emrsn.org\VC-Drive_N\AEDU1_INSIDE_SALES\SPARES\Pricelist.xlsx", True, True)
For j = 24 To m
If IsEmpty(Cells(j, 7).Value) = True Then
If IsEmpty(Cells(j, 4).Value) = True Then
pno = wb.Worksheets(2).Cells(j, 5).Value
Set rgFound = f.Worksheets(1).Range("B:B").Find(What:=pno, LookIn:=xlValues, LookAt:=xlWhole)
If rgFound Is Nothing Then
wb.Worksheets(2).Cells(j, 7).Value = "P/N not found"
Else
wb.Worksheets(2).Cells(j, 4).Value = rgFound.Offset(0, 1).Value
wb.Worksheets(2).Cells(j, 6).Value = rgFound.Offset(0, 2).Value
wb.Worksheets(2).Cells(j, 7).Value = rgFound.Offset(0, 3).Value
wb.Worksheets(2).Cells(j, 12).Value = rgFound.Offset(0, 12).Value
rgFound.EntireRow.Copy
wb.Worksheets("Pricebook").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End If
Else
pno = wb.Worksheets(2).Cells(j, 4).Value
Set rgFound = f.Worksheets(1).Range("C:C").Find(What:=pno, LookIn:=xlValues, LookAt:=xlWhole)
If rgFound Is Nothing Then
wb.Worksheets(2).Cells(j, 7).Value = "P/N not found"
Else
wb.Worksheets(2).Cells(j, 5).Value = rgFound.Offset(0, -1).Value
wb.Worksheets(2).Cells(j, 6).Value = rgFound.Offset(0, 1).Value
wb.Worksheets(2).Cells(j, 7).Value = rgFound.Offset(0, 2).Value
wb.Worksheets(2).Cells(j, 12).Value = rgFound.Offset(0, 11).Value
rgFound.EntireRow.Copy
wb.Worksheets("Pricebook").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End If
End If
End If
Next j
End If

f.Close False
Set f = Nothing
lrow = wb.Worksheets("Pricebook").Cells(wb.Worksheets("Pricebook").Rows.Count, "A").End(xlUp).Row
For m = 3 To lrow
pno = wb.Worksheets("Pricebook").Cells(m, 2).Value
Set pfind = wb.Worksheets(2).Range("E:E").Find(What:=pno, LookIn:=xlValues, LookAt:=xlWhole)
If pfind Is Nothing Then
wb.Worksheets("Pricebook").Rows(m).Interior.Color = RGB(41, 247, 110)
End If
Next m
wb.Worksheets("Pricebook").Range("A:U").AutoFilter Field:=2, Criteria1:=RGB(41, 247, 110), Operator:=xlFilterCellColor
wb.Worksheets("Pricebook").AutoFilter.Range.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)
wb.Worksheets("Pricebook").ShowAllData
wb.Worksheets(2).Activate

End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,822
Messages
5,766,648
Members
425,366
Latest member
Mau15092000

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top