several scripts in one single script

A

adinic

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").Range("A6:AL100") 'verificat*

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

WB.Worksheets("Finisaj").Range("F7:K109").Copy _
Destination:=ThisWorkbook.Worksheets("Finisaj").Range("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").Range("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!
 
B

Bob Phillips

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 said:
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").Range("A6:AL100") 'verificat*

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

WB.Worksheets("Finisaj").Range("F7:K109").Copy _
Destination:=ThisWorkbook.Worksheets("Finisaj").Range("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").Range("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",
Click to expand...
Type:=8).Row ' To Bring the required row
 
A

adinic

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!
 
B

Bob Phillips

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)
 
A

adinic

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!
 
M

markwalling

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::
 
A

adinic

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!
 
A

adinic

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!
 
M

markwalling

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?
 
B

Bob Phillips

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)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Looping(Rookies) 4
workbook open in looping 2
Copy ranges from several sheets to another one in a vertical position 1
Macro in one workbook that names a range in a different workbook 2
How do I exit on blank cell? 2
setting more than one filter 1
ThisWorkbook Problem 4
Some changes in a Macro .. 4

Top