VBA solution to copy sheets from one excel workbook and past them into my current open workbook

russelldt

Board Regular
Joined
Feb 27, 2021
Messages
74
Office Version
  1. 365
Platform
  1. MacOS
I hope someone can help me. Here is the scenario. When I open a new Job File, I need to add (or copy) 2 specific sheets (Work and Detail) to the new job file. These sheets are in the quote file (Quote Number). The options for the Quote and sheets are in dropdown menu’s, and I need to select from 2 dropdown menus to get the sheet (i.e Quote Number and Work, or Quote Number and Detail). My thinking is that there could be a macro button (shown on the attached screenshot) that is pressed once the Quote number and scope are selected. The same would apply for the Detail.

Both files reside in the same directory (Call it 2021, but in separate sub directories ( Quote subdirectory and Job subdirectory)

So, in short, I want to copy 2 sheets from a Quote file, and add them to a job file, without having to open the quote file and using the "move" option, and I am looking to a VBA solution for this. There is a thread that i have followed

VBA; Copy a whole work sheet from another workbook and have it paste into a sheet in current workbook​

and I have tried the solution that was posted:

OpenBook.Sheets("Details").UsedRange.Copy
ThisWorkbook.Worksheets("Copy of Detail").Range("A1").PasteSpecial xlPasteValues,

...without any success, as I am using 2 dropdown menus

Both files reside in the same directory (Call it 2021, but in separate sub directories ( Quote subdirectory and Job subdirectory)

I would appreciate some help






Thanks
 

Attachments

  • Screen Shot 2021-09-10 at 12.39.11.png
    Screen Shot 2021-09-10 at 12.39.11.png
    117.6 KB · Views: 9

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,086
Hello John, I have tried to run this, but i still can't figure out what's wrong. This is the message i get,

View attachment 48927

Any help would be appreciated,

Thanks
The line in red isn't an error message, it means the compiler thinks something is invalid on that line. What is the actual error message when you compile or run the macro?

Odd that it didn't show the line above it (Private Declare PtrSafe Function GetFullPathName) in red as well, but I suspect GetFullPathName isn't available on Microsoft 365 Mac, so this last macro wouldn't work anyway.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

russelldt

Board Regular
Joined
Feb 27, 2021
Messages
74
Office Version
  1. 365
Platform
  1. MacOS
The line in red isn't an error message, it means the compiler thinks something is invalid on that line. What is the actual error message when you compile or run the macro?

Odd that it didn't show the line above it (Private Declare PtrSafe Function GetFullPathName) in red as well, but I suspect GetFullPathName isn't available on Microsoft 365 Mac, so this last macro wouldn't work anyway.
Thanks John, Here is the error message i received in screen
 

Attachments

  • error.jpg
    error.jpg
    68.3 KB · Views: 5

russelldt

Board Regular
Joined
Feb 27, 2021
Messages
74
Office Version
  1. 365
Platform
  1. MacOS
Hello John, I have tried to run this, but i still can't figure out what's wrong. This is the message i get,

View attachment 48927

Any help would be appreciated,

Thanks
This message actually appears in a previous macro in the workbook. Is it possible that the solution you have given is causing this to happen?
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,086

ADVERTISEMENT

Please post the whole code, inside VBA tags, not as a screenshot.
 

russelldt

Board Regular
Joined
Feb 27, 2021
Messages
74
Office Version
  1. 365
Platform
  1. MacOS
Please post the whole code, inside VBA tags, not as a screenshot.
John, here are the two VBA scripts in the workbook. I have highlighted (in red) line with the error message

"Compiler Error.

Sub or Function not defined"



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge = 1 Then
If Target.Column = 3 Then
If Target.Value = "" Then
Target.NumberFormat = "General"
ElseIf Target.Value <= Date Then
Application.EnableEvents = False
Target.Value = DateAdd("yyyy", 1, Target.Value)
Application.EnableEvents = True
End If
End If
End If
End Sub




Public Sub Add_Quote_Sheets_To_This_Job2()

Dim QuoteNumber As String, QuoteSheet1 As String, QuoteSheet2 As String
Dim QuoteWorkbookFile As String, QuoteWorkbook As Workbook
Dim currentSheet As Worksheet, QuoteSheet As Worksheet

With ActiveSheet
QuoteNumber = .Range("A3").Value
QuoteSheet1 = .Range("C3").Value
QuoteSheet2 = .Range("D3").Value
Set currentSheet = ActiveSheet
End With

If QuoteNumber <> "" And QuoteSheet1 <> "" And QuoteSheet2 <> "" Then
QuoteWorkbookFile = GetAbsolutePath(ThisWorkbook.path & "\..\..\A Quotations\Quote Sheets\" & QuoteNumber & ".xlsm")
If Dir(QuoteWorkbookFile) <> vbNullString Then
Set QuoteWorkbook = Workbooks.Open(QuoteWorkbookFile)
Set QuoteSheet = Get_Sheet(QuoteWorkbook, QuoteSheet1)
If Not QuoteSheet Is Nothing Then QuoteSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set QuoteSheet = Get_Sheet(QuoteWorkbook, QuoteSheet2)
If Not QuoteSheet Is Nothing Then QuoteSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
QuoteWorkbook.Close False
currentSheet.Activate
Else
MsgBox "Quote workbook not found: " & vbCrLf & QuoteWorkbookFile, vbExclamation, "Add Quote Sheets To This Workbook"
End If
End If

End Sub


Private Function Get_Sheet(wb As Workbook, SheetName As String) As Worksheet
Set Get_Sheet = Nothing
On Error Resume Next
Set Get_Sheet = wb.Worksheets(SheetName)
On Error GoTo 0
End Function


Private Function GetAbsolutePath(path As String) As String
Dim pathLen As Long
GetAbsolutePath = Space(255)
pathLen = GetFullPathName(path, Len(GetAbsolutePath), GetAbsolutePath, "")
GetAbsolutePath = Left(GetAbsolutePath, pathLen)
End Function
End Function
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,086
John, here are the two VBA scripts in the workbook. I have highlighted (in red) line with the error message
Not really getting anywhere and you aren't making it easy to help you.

No need to post the Worksheet_Change code, which belongs in a sheet module - that isn't mine.

You haven't posted the code inside VBA tags - click the VBA icon in the message editor to get them and paste the VBA code between them, like this:

[CODE=vba]
Paste VBA code here
[/CODE]

Where is the
VBA Code:
#If VBA7 Then
    Private Declare PtrSafe Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
#Else
    Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
#End If
which is at the top of my post #16, VBA solution to copy sheets from one excel workbook and past them into my current open workbook ? That omission is causing the "Compiler Error. Sub or Function not defined".

You also have 2 End Function lines at the bottom of the code you posted - that would cause a compiler error.

All the code in post #16 should go at the top of a standard module, below Option Explicit, if present.

But to repeat, I've no idea if the GetFullPathName API will even work on a Mac, so another method to get the parent folder may be needed.
 
Last edited:

russelldt

Board Regular
Joined
Feb 27, 2021
Messages
74
Office Version
  1. 365
Platform
  1. MacOS
Not really getting anywhere and you aren't making it easy to help you.

No need to post the Worksheet_Change code, which belongs in a sheet module - that isn't mine.

You haven't posted the code inside VBA tags - click the VBA icon in the message editor to get them and paste the VBA code between them, like this:

[CODE=vba]
Paste VBA code here
[/CODE]

Where is the
VBA Code:
#If VBA7 Then
    Private Declare PtrSafe Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
#Else
    Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
#End If
which is at the top of my post #16, VBA solution to copy sheets from one excel workbook and past them into my current open workbook ? That omission is causing the "Compiler Error. Sub or Function not defined".

You also have 2 End Function lines at the bottom of the code you posted - that would cause a compiler error.

All the code in post #16 should go at the top of a standard module, below Option Explicit, if present.

But to repeat, I've no idea if the GetFullPathName API will even work on a Mac, so another method to get the parent folder may be needed.
Hello John,

Thanks for persisting with me, and this issue,

Much appreciated.
 

Forum statistics

Threads
1,147,962
Messages
5,744,060
Members
423,843
Latest member
alex2022

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