ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   several scripts in one single script (https://www.excelbanter.com/excel-programming/366250-several-scripts-one-single-script.html)

adinic[_18_]

several scripts in one single script
 

Hello. I have the following problem. I have 3 scripts that i have linked
to 3 buttons. Instead of pressing 3 buttons i would like to be able to
do the same thing by pressing only one button. Here are the scripts:


Code:
--------------------




SUB IMPORTLOCAL()
Dim Fname As Variant
Dim WB As Workbook
Dim DestRng As Range
ChDrive "c:\" '<<< CHANGE
ChDir "c:\Documents and Settings\" '<<< CHANGE"
Fname = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If Fname = False Then
Exit Sub ' user didn't select any file
End If
' open the source workbook
Set WB = Workbooks.Open(filename:=Fname)
' copy cell Sheet1!A1 from WB to ThisWorkbook
WB.Worksheets("Consumuri mat.").Range("A5:M63").Copy _
Destination:=ThisWorkbook.Worksheets("Consumuri mat.").Range("A5:M63") 'verificat*

WB.Worksheets("N.E cherestea").Range("A6:N100").Copy _
Destination:=ThisWorkbook.Worksheets("N.E cherestea").Range("A6:N100") 'verificat*

WB.Worksheets("PAL").Range("A6:AR100").Copy _
Destination:=ThisWorkbook.Worksheets("PAL").Range( "A6:AR100") 'verificat*

WB.Worksheets("PFL").Range("A5:AQ100").Copy _
Destination:=ThisWorkbook.Worksheets("PFL").Range( "A5:AQ100") 'verificat*

WB.Worksheets("MDF").Range("A7:AP100").Copy _
Destination:=ThisWorkbook.Worksheets("MDF").Range( "A7:AP100") 'verificat*

WB.Worksheets("Placaj").Range("A6:AL100").Copy _
Destination:=ThisWorkbook.Worksheets("Placaj").Ran ge("A6:AL100") 'verificat*

WB.Worksheets("Furnire").Range("A6:BD100").Copy _
Destination:=ThisWorkbook.Worksheets("Furnire").Ra nge("A6:BD100") 'verificat*

WB.Worksheets("Finisaj").Range("F7:K109").Copy _
Destination:=ThisWorkbook.Worksheets("Finisaj").Ra nge("F7:K109") 'verificat

WB.Worksheets("Ogl+Geam 2").Range("B3:I33").Copy _
Destination:=ThisWorkbook.Worksheets("Ogl+Geam 2").Range("B3:I33") 'verificat

WB.Worksheets("Ogl + Geam 1").Range("B3:I33").Copy _
Destination:=ThisWorkbook.Worksheets("Ogl + Geam 1").Range("B3:I33") 'verificat

WB.Worksheets("Somiera").Range("A1:F15").Copy _
Destination:=ThisWorkbook.Worksheets("Somiera").Ra nge("A1:F15") 'verificat

WB.Worksheets("PAL ROWENI").Range("A6:AR100").Copy _
Destination:=ThisWorkbook.Worksheets("PAL ROWENI").Range("A6:AR100") 'verificat*

WB.Worksheets("MDF ROWENI").Range("A7:AP100").Copy _
Destination:=ThisWorkbook.Worksheets("MDF ROWENI").Range("A7:AP100") 'verificat*

WB.Worksheets("Furnire ROWENI").Range("A6:BD100").Copy _
Destination:=ThisWorkbook.Worksheets("Furnire ROWENI").Range("A6:BD100") 'verificat*


' close the sourse workbook
WB.Close SaveChanges:=False
End Sub


--------------------



Code:
--------------------

SUB SALVARE()


'Retrieve file name to use for Save
fileSaveName = Application.GetSaveAsFilename( _
FileFilter:="Excel Files (*.xls), *.xls")

'If user specified file name, perform Save and display msgbox
If fileSaveName < False Then
ActiveWorkbook.SaveAs filename:=fileSaveName, FileFormat:=xlNormal

MsgBox "Fisier salvat in:" & fileSaveName
End If


End Sub


--------------------



Code:
--------------------

SUB EXPORT_RAND_DIN_FISA()
Dim file As String
Dim SupplyFile As Workbook
Dim TrgtFile As Variant
Dim Sht1 As String
Dim Rw As Integer
ChDrive "c:\" '<<< CHANGE
ChDir "C:\Documents and Settings\Vasnic\Desktop\" '<<< CHANGE
file = ActiveWorkbook.Name ' to save workbook name
Sht1 = ActiveSheet.Name ' to save the sheet name

TrgtFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls")

If TrgtFile = False Then
Exit Sub
End If

Set SupplyFile = Workbooks.Open(filename:=TrgtFile)
Rw = Application.InputBox("Selectati randul unde se vor exporta datele", Type:=8).Row ' To Bring the required row

With ActiveSheet
.Range("B" & Rw) = Workbooks(file).Sheets(Sht1).Range("D7")
.Range("C" & Rw) = Workbooks(file).Sheets(Sht1).Range("D10")
.Range("G" & Rw) = Workbooks(file).Sheets(Sht1).Range("D12")
.Range("H" & Rw) = Workbooks(file).Sheets(Sht1).Range("D15")
.Range("K" & Rw) = Workbooks(file).Sheets(Sht1).Range("D98")
.Range("O" & Rw) = Workbooks(file).Sheets(Sht1).Range("D119")
.Range("U" & Rw) = Workbooks(file).Sheets(Sht1).Range("J51")
.Range("Z" & Rw) = Workbooks(file).Sheets(Sht1).Range("D121")
End With

End Sub


--------------------


Ok. That's about it. So i would like the script to work in the
following fashion:

Subimportlocal - MessageBox (Is everything ok?? YES/NO). If YES then
Sub Salvare and then Sub Export_rand_din_fisa - End. If No - End.

I tried myself sevaral things but didn't work. So any help would be
apreciated. Thank you!


--
adinic
------------------------------------------------------------------------
adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359


Bob Phillips

several scripts in one single script
 
Why not create a new macro

Sub SingleMacro()
IMPORTLOCAL
SALVARE
EXPORT_RAND_DIN_FISA
End Sub


and attach the single button to this macro.

Simple, minimal, and should work.


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"adinic" wrote in
message ...

Hello. I have the following problem. I have 3 scripts that i have linked
to 3 buttons. Instead of pressing 3 buttons i would like to be able to
do the same thing by pressing only one button. Here are the scripts:


Code:
--------------------




SUB IMPORTLOCAL()
Dim Fname As Variant
Dim WB As Workbook
Dim DestRng As Range
ChDrive "c:\" '<<< CHANGE
ChDir "c:\Documents and Settings\" '<<< CHANGE"
Fname = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If Fname = False Then
Exit Sub ' user didn't select any file
End If
' open the source workbook
Set WB = Workbooks.Open(filename:=Fname)
' copy cell Sheet1!A1 from WB to ThisWorkbook
WB.Worksheets("Consumuri mat.").Range("A5:M63").Copy _
Destination:=ThisWorkbook.Worksheets("Consumuri mat.").Range("A5:M63")

'verificat*

WB.Worksheets("N.E cherestea").Range("A6:N100").Copy _
Destination:=ThisWorkbook.Worksheets("N.E cherestea").Range("A6:N100")

'verificat*

WB.Worksheets("PAL").Range("A6:AR100").Copy _
Destination:=ThisWorkbook.Worksheets("PAL").Range( "A6:AR100")

'verificat*

WB.Worksheets("PFL").Range("A5:AQ100").Copy _
Destination:=ThisWorkbook.Worksheets("PFL").Range( "A5:AQ100")

'verificat*

WB.Worksheets("MDF").Range("A7:AP100").Copy _
Destination:=ThisWorkbook.Worksheets("MDF").Range( "A7:AP100")

'verificat*

WB.Worksheets("Placaj").Range("A6:AL100").Copy _
Destination:=ThisWorkbook.Worksheets("Placaj").Ran ge("A6:AL100")

'verificat*

WB.Worksheets("Furnire").Range("A6:BD100").Copy _
Destination:=ThisWorkbook.Worksheets("Furnire").Ra nge("A6:BD100")

'verificat*

WB.Worksheets("Finisaj").Range("F7:K109").Copy _
Destination:=ThisWorkbook.Worksheets("Finisaj").Ra nge("F7:K109")

'verificat

WB.Worksheets("Ogl+Geam 2").Range("B3:I33").Copy _
Destination:=ThisWorkbook.Worksheets("Ogl+Geam 2").Range("B3:I33")

'verificat

WB.Worksheets("Ogl + Geam 1").Range("B3:I33").Copy _
Destination:=ThisWorkbook.Worksheets("Ogl + Geam 1").Range("B3:I33")

'verificat

WB.Worksheets("Somiera").Range("A1:F15").Copy _
Destination:=ThisWorkbook.Worksheets("Somiera").Ra nge("A1:F15")

'verificat

WB.Worksheets("PAL ROWENI").Range("A6:AR100").Copy _
Destination:=ThisWorkbook.Worksheets("PAL ROWENI").Range("A6:AR100")

'verificat*

WB.Worksheets("MDF ROWENI").Range("A7:AP100").Copy _
Destination:=ThisWorkbook.Worksheets("MDF ROWENI").Range("A7:AP100")

'verificat*

WB.Worksheets("Furnire ROWENI").Range("A6:BD100").Copy _
Destination:=ThisWorkbook.Worksheets("Furnire ROWENI").Range("A6:BD100")

'verificat*


' close the sourse workbook
WB.Close SaveChanges:=False
End Sub


--------------------



Code:
--------------------

SUB SALVARE()


'Retrieve file name to use for Save
fileSaveName = Application.GetSaveAsFilename( _
FileFilter:="Excel Files (*.xls), *.xls")

'If user specified file name, perform Save and display msgbox
If fileSaveName < False Then
ActiveWorkbook.SaveAs filename:=fileSaveName, FileFormat:=xlNormal

MsgBox "Fisier salvat in:" & fileSaveName
End If


End Sub


--------------------



Code:
--------------------

SUB EXPORT_RAND_DIN_FISA()
Dim file As String
Dim SupplyFile As Workbook
Dim TrgtFile As Variant
Dim Sht1 As String
Dim Rw As Integer
ChDrive "c:\" '<<< CHANGE
ChDir "C:\Documents and Settings\Vasnic\Desktop\" '<<< CHANGE
file = ActiveWorkbook.Name ' to save workbook name
Sht1 = ActiveSheet.Name ' to save the sheet name

TrgtFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls")

If TrgtFile = False Then
Exit Sub
End If

Set SupplyFile = Workbooks.Open(filename:=TrgtFile)
Rw = Application.InputBox("Selectati randul unde se vor exporta datele",

Type:=8).Row ' To Bring the required row

With ActiveSheet
.Range("B" & Rw) = Workbooks(file).Sheets(Sht1).Range("D7")
.Range("C" & Rw) = Workbooks(file).Sheets(Sht1).Range("D10")
.Range("G" & Rw) = Workbooks(file).Sheets(Sht1).Range("D12")
.Range("H" & Rw) = Workbooks(file).Sheets(Sht1).Range("D15")
.Range("K" & Rw) = Workbooks(file).Sheets(Sht1).Range("D98")
.Range("O" & Rw) = Workbooks(file).Sheets(Sht1).Range("D119")
.Range("U" & Rw) = Workbooks(file).Sheets(Sht1).Range("J51")
.Range("Z" & Rw) = Workbooks(file).Sheets(Sht1).Range("D121")
End With

End Sub


--------------------


Ok. That's about it. So i would like the script to work in the
following fashion:

Subimportlocal - MessageBox (Is everything ok?? YES/NO). If YES then
Sub Salvare and then Sub Export_rand_din_fisa - End. If No - End.

I tried myself sevaral things but didn't work. So any help would be
apreciated. Thank you!


--
adinic
------------------------------------------------------------------------
adinic's Profile:

http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359




adinic[_19_]

several scripts in one single script
 

Yes, that works but i needed the message box between the sub called
import local and the sub called salvare, as i said at the end of the
first post.:rolleyes:
Thank you!


--
adinic
------------------------------------------------------------------------
adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359


Bob Phillips

several scripts in one single script
 
You expect help with comments like that? Aren't you capable of adding that
trivial touch?


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"adinic" wrote in
message ...

Yes, that works but i needed the message box between the sub called
import local and the sub called salvare, as i said at the end of the
first post.:rolleyes:
Thank you!


--
adinic
------------------------------------------------------------------------
adinic's Profile:

http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359




adinic[_20_]

several scripts in one single script
 

If i have offended you in any way i am sorry! If i knew how to add that
trivial touch i wouldn't be asking! Thank you for your help!


--
adinic
------------------------------------------------------------------------
adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359


markwalling

several scripts in one single script
 
oh, the power of looking on google. or the help file. or old posts.
i'll give you a hint: there is this little function called msgbox. look
it up. lazy noobs ::rolls eyes::

adinic wrote:
If i have offended you in any way i am sorry! If i knew how to add that
trivial touch i wouldn't be asking! Thank you for your help!


--
adinic
------------------------------------------------------------------------
adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359



adinic[_21_]

several scripts in one single script
 

Already did that. And came up with this code :


Code:
--------------------

Sub MessageBox()


importlocal

If MsgBox("Is everything OK?", vbYesNo) = vbYes Then
Salvare
export_rand_din_fisa
End If

End Sub


--------------------


The problem is that after the message box appears i need to be able to
scroll down the file and i cannot do that. Is there a parameter for
this function that sends the message box in the background so that i
can work on the file? Thank you!


--
adinic
------------------------------------------------------------------------
adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359


adinic[_22_]

several scripts in one single script
 

Already did that. And came up with this code :


Code:
--------------------

Sub MessageBox()


importlocal

If MsgBox("Is everything OK?", vbYesNo) = vbYes Then
Salvare
export_rand_din_fisa
End If

End Sub


--------------------


The problem is that after the message box appears i need to be able to
scroll down the file and i cannot do that. Is there a parameter for
this function that sends the message box in the background so that i
can work on the file? Thank you!


--
adinic
------------------------------------------------------------------------
adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359


markwalling

several scripts in one single script
 
msgbox's are modal. you are going to need to create a modeless userform
to do this. look in your help files or google for ideas.

did your eyes get tired or something? i didn;t notice them rolling this
time. did you finally realize that we are here to help, for free, and
under no obligation to do anything?

adinic wrote:
Already did that. And came up with this code :


Code:
--------------------

Sub MessageBox()


importlocal

If MsgBox("Is everything OK?", vbYesNo) = vbYes Then
Salvare
export_rand_din_fisa
End If

End Sub


--------------------


The problem is that after the message box appears i need to be able to
scroll down the file and i cannot do that. Is there a parameter for
this function that sends the message box in the background so that i
can work on the file? Thank you!


--
adinic
------------------------------------------------------------------------
adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359



Bob Phillips

several scripts in one single script
 
No, but this might work for you

Sub MessageBox()

importlocal

ans = Application.InputBox("Is everything OK? (Type yes or no)", Type:=2)
if LCase(ans) = "yes" Then
Salvare
export_rand_din_fisa
End If

End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"adinic" wrote in
message ...

Already did that. And came up with this code :


Code:
--------------------

Sub MessageBox()


importlocal

If MsgBox("Is everything OK?", vbYesNo) = vbYes Then
Salvare
export_rand_din_fisa
End If

End Sub


--------------------


The problem is that after the message box appears i need to be able to
scroll down the file and i cannot do that. Is there a parameter for
this function that sends the message box in the background so that i
can work on the file? Thank you!


--
adinic
------------------------------------------------------------------------
adinic's Profile:

http://www.excelforum.com/member.php...o&userid=31529
View this thread: http://www.excelforum.com/showthread...hreadid=558359





All times are GMT +1. The time now is 12:07 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com