View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
adinic[_18_] adinic[_18_] is offline
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