Help with a macro to copy data from another document

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,742
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi Everyone,

This is a slightly different request to normal as I have a working macro but feel its not very good and was hoping someone could help me make it better.

The Macro Opens another document copies data and closes it again.

I Use this type of macro all the time as I have a lot of reports that need to get data from another doc and I find myself copying and pasting and editing the same macro over and over.
what I was hoping was to have an area at the top of the macro where I can easily change the parameters of the macro to save me having to go thought the document editing it.

I've done my best but I'm sure there is a better way to do this

any ideas or improvements to the code below would be very much appreciated.
and if I'm doing it all wrong, please show me.

thanks

Tony



My current Idea!
Code:
Sub Open_Other_Doc_and_Copy_Data1() 'updated

Set CopiToShet = Sheets("Data")



'Workbook to Open''''''''''''
WBName = "Test Open1"
'folder its in
Fold2 = "TEST SOIL"
''''''''''''''''''''''''''''''
'''Filepath''''''''''''''''''''''''''''''''

Fold1 = "Onedrive\Desktop"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Folds = Fold1 & "\" & Fold2 & "\" & WBName
fd = Environ$("UserProfile") & "\" & Folds & ".xlsx"


If CheckFileIsOpen(WBName & ".xlsx") = False Then
Dim wkb As Workbook
On Error Resume Next
        Set wkb = Workbooks.Open(fd)
On Error GoTo 0
End If

''''''''''''''''''''''''Copy to This Document'''''''''''''''''''''''''''''''
'This Docs Range
StartRow = 38
StartColumn = "AA"
EndColumn = "AL"
'EndRow = 10 'optional

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ThisWorkbook.Activate
'Clear Exiting Data'''''''''
lr1 = CopiToShet.Cells(Rows.Count, StartColumn).End(xlUp).Row
If lr1 < StartRow Then
lr1 = StartRow
End If
CopiToShet.Range(StartColumn & StartRow, EndColumn & lr1).ClearContents

Workbooks(WBName & ".xlsx").Activate
''''''''''''''''''''''''Copy from This Document'''''''''''''''''''''''''''''''
Set FromShet = Sheets("Copy") 'Change this name!
'This Docs Range
StartRow2 = 8
StartColumn2 = "E"
EndColumn2 = "P"
'EndRow2 = 10 'optional
FromShet.Select
lr2 = FromShet.Cells(Rows.Count, StartColumn2).End(xlUp).Row
If lr2 < StartRow2 Then
lr2 = StartRow2
End If
Range(StartColumn2 & StartRow2, EndColumn2 & lr2).SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Activate
CopiToShet.Select
Range(StartColumn & StartRow).PasteSpecial xlPasteValues
Range("A1").Select
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.DisplayAlerts = False
'Workbooks(WBName & ".xlsx").Save 'optional
Workbooks(WBName & ".xlsx").Close
Application.DisplayAlerts = True

Application.CutCopyMode = False



End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
Office Version
  1. 2019
Platform
  1. Windows
Hi,
in situation you describe where you have a common code for multiple uses, the variable parameters of the code you would pass as arguments.

When you create a procedure that will use external value(s), declare the argument(s) that represent them between the parentheses of the procedure.

For your sub procedure, the syntax you use would be

Code:
Sub Open_Other_Doc_and_Copy_Data1(ByVal WBName As String, ByVal Fold1 As sting, ByVal Fold2 As String)

'rest of code

End Sub

Arguments are declared like a normal variable but without the DIM.

Note the ByVal keyword is entered on the left side of the argument.
By passing the value of the variable instead of a reference to the variable (ByRef), any changes to the variable made by code in the subroutine or function will not be passed back to the main code.

To call your procedure you supply the required values which can be done either like this showing the parameter names.

Code:
Open_Other_Doc_and_Copy_Data1 WBName:="Test Open1", Fold1:="Onedrive\Desktop", Fold2:="TEST SOIL"

or the more general method used by many that excludes them

Code:
Open_Other_Doc_and_Copy_Data1 "Test Open1","Onedrive\Desktop","TEST SOIL"

either will work you just make your choice

I also note that you have not declared many of your variables in your procedure.
Although VBA allows you to do this , it is not considered good practice.


Have a read here for further guidance:https://powerspreadsheets.com/declare-variables-vba-excel/


Hope helpful

Dave
 

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,742
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi Dave,
thank you for your help.
I will play around with the above and get it doing what I want.
Thanks
Tony
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
Office Version
  1. 2019
Platform
  1. Windows
Hi,

Hopefully, will do what you want but don't forget to delete the existing code in your procedure that set the values

Code:
'Workbook to Open''''''''''''
WBName = "Test Open1"
'folder its in
Fold2 = "TEST SOIL"
''''''''''''''''''''''''''''''
'''Filepath''''''''''''''''''''''''''''''''


Fold1 = "Onedrive\Desktop"

Dave
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,129,563
Messages
5,637,068
Members
416,956
Latest member
mitzhaki

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