Help with a macro to copy data from another document

[tonywatsonhelp]

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!

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

 

[dmt32]

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

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.

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

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]

Hi Dave,
thank you for your help.
I will play around with the above and get it doing what I want.
Thanks
Tony

 

[dmt32]

Hi,

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

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


Fold1 = "Onedrive\Desktop"

Dave