Want To Join Many Code With One Button With One InputBox

Hello Sir :

I Have This 4 Code Working With Different Sheet Of One Workbook
Code 1
Sheet Name ("OF $")

Sub CopyPasteDataToAnotherWorkbook()
Dim sFile As String

Application.ScreenUpdating = False

Range("E6:J26").Copy

sFile = InputBox("which wrk book u want to copy?")

Workbooks.Open ("z:\42766\jan 2 dec 2014\1.3.14\" & sFile & ".xlsm")
    Worksheets("OF $").Range("H6:M26").PasteSpecial xlPasteAll
ActiveWorkbook.Close SaveChanges:=True

Application.ScreenUpdating = True

MsgBox "Data pasted successfully", vbInformation, "Task Completed"

End Sub

Code 2
Sheet Name ("OL $")

Sub CopyPasteDataToAnotherWorkbook2()
Dim sFile As String

Application.ScreenUpdating = False

Range("D6:D14").Copy

sFile = InputBox("which wrk book u want to copy?")

Workbooks.Open ("z:\42766\jan 2 dec 2014\1.3.14\" & sFile & ".xlsm")
    Worksheets("OL $").Range("V6:V14").PasteSpecial xlPasteAll
ActiveWorkbook.Close SaveChanges:=True

Application.ScreenUpdating = True

MsgBox "Data pasted successfully", vbInformation, "Task Completed"

End Sub

Code 3
Sheet Name ("OF EXT")

Sub CopyPasteDataToAnotherWorkbook3()
Dim sFile As String

Application.ScreenUpdating = False

Range("F5:Z142").Copy

sFile = InputBox("which wrk book u want to copy?")

Workbooks.Open ("z:\42766\jan 2 dec 2014\1.3.14\" & sFile & ".xlsm")
    Worksheets("OF EXT").Range("AA5:AU142").PasteSpecial xlPasteAll
ActiveWorkbook.Close SaveChanges:=True

Application.ScreenUpdating = True

MsgBox "Data pasted successfully", vbInformation, "Task Completed"

End Sub

Code 4
Sheet Name ("OL EXT")

Sub CopyPasteDataToAnotherWorkbook4()
Dim sFile As String

Application.ScreenUpdating = False

Range("C5:BP50").Copy

sFile = InputBox("which wrk book u want to copy?")

Workbooks.Open ("z:\42766\jan 2 dec 2014\1.3.14\" & sFile & ".xlsm")
    Worksheets("OL EXT").Range("C51:BP96").PasteSpecial xlPasteAll
ActiveWorkbook.Close SaveChanges:=True

Application.ScreenUpdating = True

MsgBox "Data pasted successfully", vbInformation, "Task Completed"

End Sub

I Want To Join These All Code..............should work with one click button.....+ one input box for select file using path

plz help

call  CopyPasteDataToAnotherWorkbook
call CopyPasteDataToAnotherWorkbook2
call CopyPasteDataToAnotherWorkbook3
call CopyPasteDataToAnotherWorkbook4

Hi, haroon2015,

from what I understand you want to call the procedure from each single sheet and add accordingly to that sheetīs name in the workbook it is being called from:

Sub CopyPasteDataToAnotherWorkbook()
Dim vFile As Variant
Dim strRange As String

Application.ScreenUpdating = False

Select Case ActiveSheet.Name
  Case "OF $"
    strRange = "H6:M26"
    Range("E6:J26").Copy
  Case "OL $"
    strRange = "V6:V14"
    Range("D6:D14").Copy
  Case "OF EXT"
    strRange = "AA5:AU142"
    Range("F5:Z142").Copy
  Case "OL EXT"
    strRange = "C51:BP96"
    Range("C5:BP50").Copy
  Case Else
    Exit Sub
End Select

vFile = InputBox("which wrk book u want to copy?")

If vFile <> False Then
  Workbooks.Open ("z:\42766\jan 2 dec 2014\1.3.14\" & vFile & ".xlsm")
  Worksheets(ActiveSheet.Name).Range(strRange).PasteSpecial xlPasteAll
  ActiveWorkbook.Close SaveChanges:=True
End If

Application.ScreenUpdating = True

MsgBox "Data pasted successfully", vbInformation, "Task Completed"

End Sub

patel45īs suggestion would get the range to copy from the very same sheet.

Ciao,
Holger

Hi, haroon2015,

I would never ask the user for the name of a workbook to type in via Inputbox but use either the xlDialog or GetopenFilename:

Sub CopyPasteDataToAnotherWorkbook2()
Dim vFile As Variant
Dim varSheets As Variant
Dim varCopyDest As Variant
Dim varCopyTarg As Variant
Dim lngCounter As Long
Dim wb As Workbook

varSheets = Array("OF $", "OL $", "OF EXT", "OL EXT", "C51:BP96")
varCopyDest = Array("E6:J26", "D6:D14", "F5:Z142", "C5:BP50")
varCopyTarg = Array("H6:M26", "V6:V14", "AA5:AU142", "C51:BP96")

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

If vFile <> False Then
  Application.ScreenUpdating = False
  On Error Resume Next
  Set wb = Workbooks.Open(vFile)
  If Not wb Is Nothing Then
    For lngCounter = LBound(varSheets) To UBound(varSheets)
      ThisWorkbook.Worksheets(varSheets(lngCounter)).Range(varCopyDest(lngCounter)).Copy
      wb.Worksheets(varSheets(lngCounter)).Range(varCopyTarg(lngCounter)).PasteSpecial xlPasteAll
    Next lngCounter
    wb.Close SaveChanges:=True
    Set wb = Nothing
  Else
    MsgBox "Workbook not found!"
    Application.ScreenUpdating = True
    Exit Sub
  End If
  Application.ScreenUpdating = True

  MsgBox "Data pasted successfully", vbInformation, "Task Completed"
End If

End Sub

Ciao,
Holger

Hi, haroon2015,

something is wrong plz check the sample files

Agree on that as no code is in the workbook copy.xlsm as it would be needed to run

      ThisWorkbook.Worksheets(varSheets(lngCounter)).Range(varCopyDest(lngCounter)).Copy

as ThisWorkbook expects the code to be located in exactly that workbook (copy.xlsm).

      Workbooks("copy.xlsm").Worksheets(varSheets(lngCounter)).Range(varCopyDest(lngCounter)).Copy

would work around that and accept the code in any other workbook except paste.xlsm but I donīt like hardcoding workbook names in the code.

Ciao,
Holger