Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10,593
Default 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



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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.
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

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10,593
Default 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.
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



  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11
Default 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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
delete scripts AND Excel Worksheet Functions 1 March 20th 09 01:16 PM
Forumlas or scripts? Gor_yee Excel Discussion (Misc queries) 0 October 16th 06 01:53 PM
SQL Scripts in Excel markus Excel Discussion (Misc queries) 1 October 13th 06 12:39 PM
SQL scripts and ODBC James McDowell[_2_] Excel Programming 0 January 13th 06 10:38 PM
Macintosh and VB Scripts ccoverne Excel Programming 2 November 29th 04 09:11 PM


All times are GMT +1. The time now is 04:14 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"