combine two codes as in one for two different sheets whether input or output

[abdo meghari]

Hi experts
here are two codes to export data from open file to closed file and sheet to a different sheet .
my question , could make code short by combining as in one instead of Repeat the whole code twice for two closed file name and two different sheets names ?
so I have open file contains sheets TABLE 1& MISSED should export data to two closed files names Elmarghanie Brand & COMPARE REPORTS for sheets REPORT & OUTPUT .

Sub OpenFilesFromFolder1()
  Dim ExtBk As Workbook
  Dim IntBk As Workbook
  Dim FolderPath As String
  Dim FilePath As String
  Dim lRow As Long
  Dim Rng1 As Range, Rng2 As Range
 
  Set IntBk = ActiveWorkbook

  lRow = IntBk.Worksheets("TABLE 1").Cells(Rows.Count, 1).End(xlUp).Row

   FolderPath = "C:\Users\MY-NAME\Downloads\BRIDGESTONE REPORT\"
 
  FilePath = Dir(FolderPath & "Elmarghanie Brand .xlsm")
  If FilePath <> "" Then
    Set ExtBk = Workbooks.Open(FolderPath & FilePath)
  else   'Exit the sub if not found! Else errors will occur
     msgbox "File Elmarghanie Brand .xlsm not found"
     exit sub
  End If

  Application.ScreenUpdating = False
  'clear any old values:
  with ExtBk.Worksheets("TABLE 1")
      .Range("A2:E" & .Cells(.Rows.Count, 1).End(xlUp).Row).Clearcontents
  end with
'  For i = 2 To lRow
'
'    ExtBk.Worksheets("REPORT").Cells(i, 1).Value = IntBk.Worksheets("TABLE 1").Cells(i, 1).Value
'   
'  Next
'Why do the copy one row at a time? DO it all in once:
  ExtBk.Worksheets("REPORT").Range("A2:A"& lRow).Value = IntBk.Worksheets("TABLE 1").Range("A2:A"& lRow).Value
  Set Rng1 = IntBk.Worksheets("TABLE 1").Range("B2:E" & lRow)
  Set Rng2 = ExtBk.Worksheets("REPORT").Range("C2:F" & lRow)
'  Rng1.Copy
'  Rng2.PasteSpecial xlPasteValues
'' Range copy / paste is slow. Just set the values:
  rng2.Value = Rng1.Value
  Application.ScreenUpdating = True
  Application.DisplayAlerts = False
  ExtBk.Save
  ExtBk.Close
  Application.DisplayAlerts = True
End Sub

Sub OpenFilesFromFolder2()
  Dim ExtBk As Workbook
  Dim IntBk As Workbook
  Dim FolderPath As String
  Dim FilePath As String
  Dim lRow As Long
  Dim Rng1 As Range, Rng2 As Range
 
  Set IntBk = ActiveWorkbook

  lRow = IntBk.Worksheets("MISSED").Cells(Rows.Count, 1).End(xlUp).Row

   FolderPath = "C:\Users\MY-NAME\Downloads\BRIDGESTONE REPORT\"
 
  FilePath = Dir(FolderPath & "COMPARE REPORTS.xlsm")
  If FilePath <> "" Then
    Set ExtBk = Workbooks.Open(FolderPath & FilePath)
  else   'Exit the sub if not found! Else errors will occur
     msgbox "File COMPARE REPORTS.xlsm not found"
     exit sub
  End If

  Application.ScreenUpdating = False
  'clear any old values:
  with ExtBk.Worksheets("OUTPUT")
      .Range("A2:E" & .Cells(.Rows.Count, 1).End(xlUp).Row).Clearcontents
  end with
'  For i = 2 To lRow
'
'    ExtBk.Worksheets("OUTPUT").Cells(i, 1).Value = IntBk.Worksheets("MISSED").Cells(i, 1).Value
'   
'  Next
'Why do the copy one row at a time? DO it all in once:
  ExtBk.Worksheets("OUTPUT").Range("A2:A"& lRow).Value = IntBk.Worksheets("MISSED").Range("A2:A"& lRow).Value
  Set Rng1 = IntBk.Worksheets("MISSED").Range("B2:E" & lRow)
  Set Rng2 = ExtBk.Worksheets("OUTPUT").Range("C2:F" & lRow)
'  Rng1.Copy
'  Rng2.PasteSpecial xlPasteValues
'' Range copy / paste is slow. Just set the values:
  rng2.Value = Rng1.Value
  Application.ScreenUpdating = True
  Application.DisplayAlerts = False
  ExtBk.Save
  ExtBk.Close
  Application.DisplayAlerts = True
End Sub

I hope somebody could help for this .
thanks

 

[dmt32]

I just ran code with your sample data & got this result in a test export file.

Test1.xlsx
	A	B	C	D	E	F
2	1		BS 1200R20	G580	JAP	30
3	2		BS 1200R20	G580	THI
4	3		BS 1200R24	G582	JAP	2
5	4		BS 1200R20	R187	JAP	0
6	5		BS 1200R24	G580	JAP	50
7	6		BS 13R22.5	R187	JAP
8	7		BS 1400R20	R180	JAP
9	8		BS 1400R20	R180BZ	JAP
10	9		BS 1400R20	VSJ	JAP	22
11	10		BS 165R13C	R624	INDO	4
12	11		BS 175/70R13	EP150	THI
13	12		BS 185/65R15	B250	JAP
14	13		BS 195/75R16C	613V	JAP
15	14		BS 195R14C	613V	JAP
16	15		BS 195R14C	R623	THI
17	16		BS 195R15C	613V	JAP	4
18	17		BS 205/60R16	T005	THI	0
19	18		BS 205/70R15C	R623	THI	8
20	19		BS 205R16C	D840	THI
21	20		BS 215/50R17	EP300	THI
22	21		BS 215/55R17	T005	JAP
23	22		BS 215/60R16	ER30	JAP	8
24	23		BS 215/65R15	T005	INDO	4
25	24		BS 215/70R15C	R624	TR
REPORT

 

[abdo meghari]

strange !!
I no know what my mistake !
seem to work , just question I have to repeat copying macro Sub Test() for the second sheet for the same closed file ?
I mean copy sheet=MISSED and export sheet =OUTPUT for Elmarghanie Brand closed file , because I mentioned in OP two copies sheets for open file & two exporting sheets for Elmarghanie Brand closed file
copy sheets= TABLE 1& MISSED and export sheets =REPORT & OUPUT

 

[dmt32]

For both files you just pass the required parameter values to the code

something like this may do what you want

Sub Test()
    Dim Filename As Variant, CopySheet As Variant, ExportSheet As Variant
    Dim i As Long
    
     FolderPath = "C:\Users\MY-NAME\Downloads\BRIDGESTONE REPORT\"
     
     Filename = Array("Elmarghanie Brand .xlsm", "COMPARE REPORTS.xlsm")
     CopySheet = Array("TABLE 1", "MISSED")
     ExportSheet = Array("REPORT", "OUTPUT")
     
     For i = LBound(Filename) To UBound(Filename)
        OpenFilesFromFolder Filename(i), FolderPath, CopySheet(i), ExportSheet(i)
     Next i

Dave

 

[abdo meghari]

great !
much appreciated for your coming back for me and thanks for your solution

 

[dmt32]

great !
much appreciated for your coming back for me and thanks for your solution

welcome glad resolved & appreciate your feedback

Dave