Code to copy another column and clear data before exporting

[abdo meghari]

Hi experts,
I need add some lines to this code
first before export data to Elmarghanie Brand .xlsm file should clear contents data from A2:E
second should copy data for column A2:A from open file contains Worksheets("TABLE 1") to sheet REPORT for Elmarghanie Brand .xlsm file into column A2:A
the code will export data from open file contains Worksheets("TABLE 1") to closed Elmarghanie Brand .xlsm file contains REORT sheet
here is the code

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)
  End If
  Application.ScreenUpdating = False
  For i = 2 To lRow

    ExtBk.Worksheets("REPORT").Cells(i, 1).Value = IntBk.Worksheets("TABLE 1").Cells(i, 1).Value
   
  Next
  Set Rng1 = IntBk.Worksheets("TABLE 1").Range("B2:E" & lRow)
  Set Rng2 = ExtBk.Worksheets("REPORT").Range("C2:F" & lRow)
  Rng1.Copy
  Rng2.PasteSpecial xlPasteValues
  Application.ScreenUpdating = True
  Application.DisplayAlerts = False
  ExtBk.Save
  ExtBk.Close
  Application.DisplayAlerts = True
End Sub

thanks

 

[sijpie]

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

 

[abdo meghari]

it's perfect!
just there is typo . it will clear data from source file and gives error .
should change sheet name from

with ExtBk.Worksheets("TABLE 1")

to

with ExtBk.Worksheets("REPORT")

thanks very much for your help.