LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #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

 
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 08:01 AM.

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"