Excel VBA - how to account for errors from searching - vba

Sheets("Table").Select
Cells.Find(What:="Cat", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(1, 1).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(rowoffset:=0, columnoffset:=-1).Select
Selection.Resize(Selection.Rows.Count + 0, Selection.Columns.Count + 10).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Table").Select
Cells.Find(What:="Bat", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(1, 1).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(rowoffset:=0, columnoffset:=-1).Select
Selection.Resize(Selection.Rows.Count + 0, Selection.Columns.Count + 10).Select
Selection.Copy
Sheets("Sheet1").Select
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I'm very new to excel and trying to account for errors that will occur when one of the words I'm searching for are not on the table. I'm not sure how to format it to work, but basically for the first search, if it errors then go to the next search without doing any of selection, copy, and paste part (same for the second search).

Create a Range variable to assign your find function to, then use an If statement to determine if it exists or not. If no, move to the next one.
Dim fRange As Range
Sheets("Table").Select
Set fRange = Cells.Find(What:="Cat", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(1, 1)
If Not fRange Is Nothing Then
fRange.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(rowoffset:=0, columnoffset:=-1).Select
Selection.Resize(Selection.Rows.Count + 0, Selection.Columns.Count + 10).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Table").Select
Set fRange = Cells.Find(What:="Bat", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(1, 1)
If Not fRange Is Nothing Then
fRange.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(rowoffset:=0, columnoffset:=-1).Select
Selection.Resize(Selection.Rows.Count + 0, Selection.Columns.Count + 10).Select
Selection.Copy
Sheets("Sheet1").Select
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

Related

VBA Error 13 With Find code

I am having an issue with type mismatch, in my table the value is general since it is copied and pasted values from a pivot table
Error thrown here:
Set mf = Columns("F").Find(What:=ONE, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
Dim ONE As String
Worksheets("Chart").Activate
Columns("A:B").Select
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
ONE = Cells(2, "F").Value
Sheets("Paste Data Table").Select
Set mf = Columns("F").Find(What:=ONE, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
ActiveCell.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Top 5 Breakdown").Select
Sheets("Top 5 Breakdown").Select
Range("A2").Select
ActiveSheet.Paste
Worksheets("Paste Data Table").Activate
Range("A2").Select
Application.CutCopyMode = False
What causes error in this Find method is:
After:=ActiveCell
You can't search after cell which is not in searched range, column F in this case. Your active cell is not in column F.

If file is not open go to next

From multiple workbooks I copy info into one Workbook. This works like a charm. I just got informed that in a few weeks I'll have to add another file to copy data from. I wanted to get the Macro going now but if I don't have the new workbook open the macro gets stuck. I have tried a few different ways but I don't get it to work.
I have the same code going with the other 3 workbooks, so when this comes I want the macro to skip it if Workbook is not open.
Any suggestions?
Windows("filename.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Masterfile.xlsm").Sheets("Electra").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
This code will step through the workbooks that you have open and check against a list of file names that you need.
There's a couple of problems that could occur:
Your workbook must have a sheet called Sheet1 as the code doesn't check for this.
If you have a file called book1.xlsm and 1book1.xlsm. book1.xlsm occurs in both.
Finding the last cell in columns A:K could be improved. Currently it will go from A2 to the last row containing data in column K.
All information will be pasted starting at cell A2. You need code to find the last row on the Electra sheet as well.
Sub Test()
Dim sFileNames As String
Dim wrkBk As Workbook
sFileNames = "Somebook.xls, book1.xlsm, book2.xlsx"
For Each wrkBk In Workbooks
If InStr(UCase(sFileNames), UCase(wrkBk.Name)) > 0 Then
With wrkBk.Worksheets("Sheet1")
.Range(.Cells(2, 1), .Cells(.Rows.Count, 11).End(xlUp)).Copy
ThisWorkbook.Worksheets("Electra").Range("A2").PasteSpecial xlPasteValues
End With
End If
Next wrkBk
End Sub
Edit:
To paste to different sheets in the MasterFile one option is to use a dictionary to hold workbook & destination sheet pairings.
This code will add the file names as keys and the destination sheets as values. It then checks if the workbook name exists within the dictionary, if it does it copies the data from Sheet1 and pastes the values into relevant sheet.
Sub Test()
Dim dict As Object
Dim wrkBk As Workbook
Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
dict.Add "Book2.xlsx", "Sheet1"
dict.Add "Book3.xlsx", "Sheet2"
For Each wrkBk In Workbooks
If dict.exists(wrkBk.Name) Then
With wrkBk.Worksheets("Sheet1")
.Range(.Cells(2, 1), .Cells(.Rows.Count, 11).End(xlUp)).Copy
ThisWorkbook.Worksheets(dict(wrkBk.Name)).Range("A2").PasteSpecial xlPasteValues
End With
End If
Next wrkBk
End Sub
Edit 2:
If the source workbooks are all closed at the start then use this code to open the relevant files, copy the info and close the file again.
Sub Test()
Dim dict As Object
Dim wrkBk As Workbook
Dim vItem As Variant
Dim sPath As String
'All workbooks to open will be in this folder.
'Remember to include the final back-slash (\).
sPath = "C:\Test\"
Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
'If files will not all be in the same folder, then
'full file path must be included here and remove
'references to sPath variable in the code.
dict.Add "Book2.xlsx", "Sheet1"
dict.Add "Book3.xlsx", "Sheet2"
For Each vItem In dict
Set wrkBk = Workbooks.Open(sPath & vItem)
With wrkBk.Worksheets("Sheet1")
.Range(.Cells(2, 1), .Cells(.Rows.Count, 11).End(xlUp)).Copy
ThisWorkbook.Worksheets(dict(wrkBk.Name)).Range("A2").PasteSpecial xlPasteValues
End With
wrkBk.Close SaveChanges:=False
Next vItem
End Sub
This is maybee the most good looking but it actually worked, I never done Call before so I just had to try. I can run this multiple time with different books open and it don't bug out or mess things up. As faar as two test are made.
Sub Steg11()
'
' Steg1 Macro
' Macrot flyttar data från CDPPT fil med försäljningsdata,
' från fil med Electras försäljning och fil med produktdata.
' Kopierar formler, rensar försäljning till Lagerhållare
Dim MainWkbk As Workbook
Dim NextWkbk As Workbook
Set MainWkbk = ActiveWorkbook
Set NextWkbk = ActiveWorkbook
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
' Letar in CDPPT, lägger in formler, sorterar bladet.
On Error GoTo 3
Windows("CDPPT.xlsx").Activate
Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("CDPPT").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("CDPPT").Select
Range(Range("I2"), Range("I2").End(xlToRight)).Copy
Range("H2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Offset(1, 0).Select
ActiveSheet.Paste
Application.Goto Sheets("CDPPT").Range("A:M")
Selection.Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Tar bort data där telia inte ska betala skatt
Application.Goto Sheets("CDPPT").Range("E1")
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*BRIGHTSTAR*" _
, Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*ELECTRA*" _
, Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-6
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*Ingram*" _
, Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-9
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=3, Criteria1:="=*brev*" _
, Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=3, Criteria1:="=*Konfig*" _
, Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*(Manuellt
inmatad)*" _
, Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
3
Call Produktdata
End Sub
Sub Produktdata()
'Letar in produktdata
On Error GoTo 4
Windows("Produktdata.xlsx").Activate
If ActiveSheet.AutoFilterMode Then Cells.AutoFilter
Range(Range("A:J"), Range("A:J").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("Produktdata").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
4
Call Electra
End Sub
Sub Electra()
'Letar in data från Lagerhållare
On Error GoTo 5
Windows("Electra sales.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("Electra").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
5
Call TalkTelecom
End Sub
Sub TalkTelecom()
'Letar in data från Lagerhållare
On Error GoTo 6
Windows("TalkTelecom.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("TalkTelecom").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
6
Call Techdata
End Sub
Sub Techdata()
'Letar in data från Lagerhållare
On Error GoTo 7
Windows("TechData.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("TechData").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
7
Call Continue
End Sub
Sub Continue()
' Utför text till kolumn
Application.Goto Sheets("Produktdata").Range("C:C")
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Application.Goto Sheets("CDPPT").Range("F:F")
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.RefreshAll
'Lägger in år och månad i blad arbetsbeskrivning
Application.Goto Sheets("CDPPT").Range("G2")
Range("G2").Copy
Sheets("Arbetsbeskrivning").Select
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D10").Activate
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-1],2)"
Range("D10").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D10").Select
Selection.TextToColumns Destination:=Range("D10"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("D9").Activate
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[1]C,Datalistor!R[-6]C[1]:R[5]C[2],2,0)"
Range("C9").Activate
ActiveCell.FormulaR1C1 = "=Left(R[1]C,4)"
Range("C4").Activate
' kopierar data och skapar Pivotdata Telia försäljning
Sheets("CDPPT").Select
Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).Copy
Destination:=Sheets("Matchning"). _
Range("A2")
Application.CutCopyMode = False
Sheets("CDPPT").Select
Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).Copy
Destination:=Sheets("Pivotgrund"). _
Range("A2")
Application.CutCopyMode = False
ActiveWorkbook.RefreshAll
' Tar bort dubletter
Application.Goto Sheets("Matchning").Range("A:M")
Selection.Sort Key1:=Range("F1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.Goto Sheets("Matchning").Range("A1")
Range(Range("A1"), Range("A1").End(xlToRight).End(xlDown)).Select
ActiveSheet.Range("A:L").RemoveDuplicates Columns:=6, Header:= _
xlYes
ActiveWorkbook.RefreshAll
' letar in Pivotdata
Application.Goto Sheets("Matchning").Range("H2")
ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-2],Pivot!C[-7]:C[-6],2,0)"
Range("H2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveWorkbook.RefreshAll
' Skapar fil med prod med saknad data
Application.Goto Sheets("Matchning").Range("A1")
Range("A1").Select
ActiveSheet.Range("$A:P").AutoFilter Field:=12, Criteria1:= _
"Check for data"
Range(Range("A1"), Range("A1").End(xlToRight).End(xlDown)).Copy
Range("A1").Select
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.Windows(1).Caption = "Produktdata saknas"
Columns("M:P").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("Datamatchningsfil.xlsm").Activate
Application.Goto Sheets("Matchning").Range("A1")
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
Application.ScreenUpdating = True
Sheets("Arbetsbeskrivning").Select
Range("C13").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = _
"Steg 1 klart!"
Range("C14").Select
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
MsgBox ("Steg 1 klart")
End Sub

Copying data to another sheet

I am having trouble understanding what the below function is doing.
The function itself has the ability to copy data to the sheet Sheet History. However, I do not get how it is doing it?
Sub histFunc()
Dim Y As String
Y = "R" & Range("G7").Value
Sheets("Sheet History").Select
Range("h17").Select
Cells.Find(What:=Y, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Sheet Current").Select
End Sub
Any suggestions how this macro is operating?
I appreciate your replies!
In short, the code searches for the value in G7 in Sheet History and replaces the right part of that line with values only, i.e. removing references or values.
Step-by-step Explanation
Get the value of cell G7:
Y = "R" & Range("G7").Value
Select sheet Sheet History and select cell H17:
Sheets("Sheet History").Select
Range("h17").Select
Executes the Find method over Cells, all cells in the sheet (note that if no parameter is given it is the range of all Cells in the current Sheet):
Cells.Find(What:=Y, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
This returns:
A Range object that represents the first cell where that information is found.
For more info see the Find documentation.
Now due to .Activate the (first) cell is selected where the value was found. This selection is extended to the end of the line:
Range(Selection, Selection.End(xlToRight)).Select
Then the CutCopyMode is deactivated to clear the clipboard after usage:
Application.CutCopyMode = False
Now the selected cells are copied and pasted:
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Note that they are pasted on with PasteSpecial on the same location, using xlPasteValues to only maintain the values, and therefore not to have any formulas nor references in the cells.
Now go to Sheet Current:
Sheets("Sheet Current").Select
After a bit of cleaning, this is what this could look like (explanations below) :
Sub histFunc()
Dim FindRange As Range, _
LookForValue As String
LookForValue = "R" & Range("G7").Value
With Sheets("Sheet History")
.Range("h17").Activate
Set FindRange = .Cells.Find(What:=LookForValue, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
Application.CutCopyMode = False
Range(FindRange, FindRange.End(xlToRight)).Copy
FindRange.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End With
Application.CutCopyMode = False
Sheets("Sheet Current").Select
End Sub
I changed Y to LookForValue for better understanding and used a Range variable to reference the result of the Find method.
So this code, step by step :
Define LookForValue as "R" & Range("G7").Value
Search for that value in the formulas of Sheet History
Copy the data block (in the row of the result, from result to right, until there is a blank)
Paste it at the same place but in values, so that you get rid of the formulas!

How do I access a specific workbook that I have open, without using its name?

I'm recording this macro that transfers data between a few different documents. One of the workbooks, "Transfer Template", stays constant. But the other will change. Here is the code that I am using. (I know it's slow and a lot of it is irrelevant, but I just need to make it work).
What I'm assuming is that I have to replace 'Windows("RFQ_14446.xlsm") with ActiveWorkbook or something similar.
Sub Initial_Transfer_Macro()
'
' Initial_Transfer_Macro Macro
'
'
Windows("RFQ_14446.xlsm").Activate
Range("J51").Select
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B1").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B4").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B5").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B6").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("K6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("D12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("D22").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("D11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("K18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("K3").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("C14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "36"
Range("I5").Select
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("C20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Cells.Replace What:=" Rev. ", Replacement:="-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="RFQ ", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
Easiest way is to set references to each workbook at the start of your code:
Sub SO()
Dim thisWorkbook As Excel.Workbook
Dim otherWorkbook As Excel.Workbook
Set thisWorkbook = ActiveWorkbook
Set otherWorkbook = Workbooks("Transfer Template.xlsm")
'// ... Rest of code here
End Sub
Once this is done you can refer to that variable instead, for example:
Debug.Print thisWorkbook.Sheets.Count
or
otherWorkbook.Sheets(1).Range("A1").Value = thisWorkbook.Sheets(2).Range("B1").Value
Just crude examples but should give you the base of the logic...
Another thing worth noting is that if the code is being run from the workbook that you want to refer to, then simply using ThisWorkbook will suffice:
Sub Example()
Workbooks("Transfer Template.xlsm").Activate
MsgBox ActiveWorkbook.Name
MsgBox ThisWorkbook.Name
End Sub
If you don't know the workbook name but it is the only other one open at the same time (in the same instance of Excel), you can loop through them like this:
Sub TransferTemplate()
Dim wbTemplate As Workbook: Set wbTemplate = ActiveWorkbook
Dim wbDestination As Workbook
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name <> wbTemplate.Name Then
Set wbDestination = wb
End If
Next wb
'Example copy
wbTemplate.Worksheets(1).Range("B1").Value = wbDestination.Worksheets(1).Range("J51").Value
End Sub

Greater than in Auto Filter Criteria in VBA

How do I use greater than in this code?
ActiveSheet.Range("$A$1:$BG$5158").AutoFilter Field:=13, Criteria1:= _
">"Range("BJ1").Value, Operator:=xlAnd
Here is the complete code
Sheets("New Hire").Select
Range("CI1").Select
Selection.Copy
ChDir "D:\Sales Report"
Workbooks.Open Filename:="D:\Sales Report\Global_New_Hire_Report.xlsb"
Windows("Global_New_Hire_Report.xlsb").Activate
Range("BJ1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Selection.AutoFilter
Windows("Global_New_Hire_Report.xlsb").Activate
ActiveSheet.Range("$A$1:$BG$5158").AutoFilter Field:=13, Criteria1:= _
">"Range("BJ1").Value, Operator:=xlAnd
Criteria1 argument expects String so you need to concatenate it like:
ActiveSheet.Range("$A$1:$BG$5158").AutoFilter Field:=13, _
Criteria1:=">" & Range("BJ1").Value