# export data from  file to another closed file with skip column



## Hasson (Dec 18, 2022)

Hi
I  have  data in file  target  from A2:F  in sheet DATA     and  should  copy  column A   to  column D for  file  destenaion  and  columns B2:F    to columns F2:G for sheet EXPORTED. the  closed file is  destenaiton  when  export  data  from  open  file  target .
I  have  about   4000 rows
I  try  with  this  code , but  doesn't  work  for  me

```
Option Explicit

Sub UpdateData()
    Dim IntSht As Worksheet
    Dim IntBk As Workbook
    Dim ExtBk As Workbook
    Dim ExtFile As String


    Set IntBk = ActiveWorkbook
    Set IntSht = IntBk.ActiveSheet
    ExtFile = "C:\Users\PC Hass\Desktop\TABLES\ file.xlsm"
    If Dir(ExtFile) <> "" Then
  
        IntBk.Worksheets("Data").Range("a2:F4000").Value = ExtFile
    End If
    On Error Resume Next
    Set ExtBk = Workbooks(Dir(ExtFile))
    On Error GoTo 0
    If ExtBk Is Nothing Then
        Application.Workbooks.Open ExtFile
        Set ExtBk = Workbooks(Dir(ExtFile))
    End If
    IntBk.IntSht.Range("A2:F1000").Copy ExtBk.Worksheets("EXPORTED").Range("D" & Rows.Count).End(xlUp).Offset(1)
    Application.DisplayAlerts = False
    ExtBk.Save
    ExtBk.Close
    Application.DisplayAlerts = True
End Sub
```

target.xlsmABCDEF1ITEMIDQTY1QTY2QTY3BALANCE21TT/W-1 MM CLA1 23M-1 IT50050032QQW-2 TH NM-1 CLA2 VBG L CHI043QQW-3 CV CLA3 TAI7003373354QQW-4 M*12.5 CLA4 TR2001218865QQW-5 CLA5 EG30030076MMR12/100 AS-1000/1 TMR12001287QQW-6 M230 TU1198QQW-7 S** CLA7 US140011399109QQW-8 CLA8 UK01110QQW-9 CLA9 N BR1600115991211QQW-10 BN CLA10 IT800008001312QQW-11 LVD CH9009001413BB12 QQW-12 CLA12 JA111000119891514BB12 QQW-12 CLA12 JA1220001019901615BB12 QQW-12 CLA12 JA1330001029901716BB12 QQW-12 CLA12 JA1440001039901817BB12 QQW-12 CLA12 JA1550001049901918BB12 QQW-12 CLA12 JA1660001059902019BB12 QQW-12 CLA12 JA1770001069902120BB12 QQW-12 CLA12 JA1880001079902221BB12 QQW-12 CLA12 JA1990001089902322BB12 QQW-12 CLA12 JA2010000109990DATACell FormulasRangeFormulaF2:F23F2=C2+D2-E2


before
destenation.xlsmDEFGHIJ1ITEMBATCHIDQTY1QTY2QTY3BALANCE23456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129EXPORTED
result  should be  like  this
destenation.xlsmDEFGHIJ1ITEMBATCHIDQTY1QTY2QTY3BALANCE21TT/W-1 MM CLA1 23M-1 IT50050032QQW-2 TH NM-1 CLA2 VBG L CHI043QQW-3 CV CLA3 TAI7003373354QQW-4 M*12.5 CLA4 TR2001218865QQW-5 CLA5 EG30030076MMR12/100 AS-1000/1 TMR12001287QQW-6 M230 TU1198QQW-7 S** CLA7 US140011399109QQW-8 CLA8 UK01110QQW-9 CLA9 N BR1600115991211QQW-10 BN CLA10 IT800008001312QQW-11 LVD CH9009001413BB12 QQW-12 CLA12 JA111000119891514BB12 QQW-12 CLA12 JA1220001019901615BB12 QQW-12 CLA12 JA1330001029901716BB12 QQW-12 CLA12 JA1440001039901817BB12 QQW-12 CLA12 JA1550001049901918BB12 QQW-12 CLA12 JA1660001059902019BB12 QQW-12 CLA12 JA1770001069902120BB12 QQW-12 CLA12 JA1880001079902221BB12 QQW-12 CLA12 JA1990001089902322BB12 QQW-12 CLA12 JA2010000109990 EXPORTEDCell FormulasRangeFormulaJ2:J23J2=G2+H2-I2


----------



## Flashbond (Dec 19, 2022)

```
Sub OpenFilesFromFolder()
  Dim ExtBk As Workbook
  Dim IntBk As WorkBook
  Dim FolderPath As String
  Dim FilePath As String
  Dim lRow As Long
 
  IntBk = ActiveWorkbook
  lRow = IntBk.Worksheets("DATA").Cells(Rows.Count, 1).End(xlUp).Row

  FolderPath = "C:\Users\PC Hass\Desktop\TABLES\"
  FilePath = Dir(FolderPath & "file.xlsm")
  If FilePath <> "" Then
    Set ExtBk = Workbooks.Open(FolderPath & FilePath)
  End If
  Application.ScreenUpdating = False
  For i = 2 to lRow
    ExtBk.Worksheets("EXPORTED").Cells(i, 4).Value = IntBk.Worksheets("DATA").Cells(i, 1).Value
    ExtBk.Worksheets("EXPORTED").Cells(i, 6).Value = IntBk.Worksheets("DATA").Cells(i, 2).Value
    ExtBk.Worksheets("EXPORTED").Cells(i, 7).Value = IntBk.Worksheets("DATA").Cells(i, 3).Value
    ExtBk.Worksheets("EXPORTED").Cells(i, 8).Value = IntBk.Worksheets("DATA").Cells(i, 4).Value
    ExtBk.Worksheets("EXPORTED").Cells(i, 9).Value = IntBk.Worksheets("DATA").Cells(i, 5).Value
    ExtBk.Worksheets("EXPORTED").Cells(i, 10).Formula = "=G" & i & "+H" & i & "-I" & i
  Next
  Application.ScreenUpdating = True
  Application.DisplayAlerts = False
  ExtBk.Save
  ExtBk.Close
  Application.DisplayAlerts = True
End Sub
```


----------



## Hasson (Dec 19, 2022)

thanks !  but  unfortunately  shows error *object variable or  with block variable not set*  in this  line

```
IntBk = ActiveWorkbook
```


----------



## Flashbond (Dec 19, 2022)

Hasson said:


> thanks !  but  unfortunately  shows error *object variable or  with block variable not set*  in this  line
> 
> ```
> IntBk = ActiveWorkbook
> ```


Oh, it should include Set command:

```
Set IntBk = ActiveWorkbook
```


----------



## Hasson (Dec 19, 2022)

thanks   for  your  solution  
strangely  it  takes  more  time  when  finish  running despite of  the  data  are  not  big , just  4000 rows !!


----------



## Flashbond (Dec 19, 2022)

ı am not good at working with ranges. Maybe this could be a little bit faster:

```
Sub OpenFilesFromFolder()
  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("DATA").Cells(Rows.Count, 1).End(xlUp).Row

  FolderPath = "C:\Users\PC Hass\Desktop\TABLES\"
  FilePath = Dir(FolderPath & "file.xlsm")
  If FilePath <> "" Then
    Set ExtBk = Workbooks.Open(FolderPath & FilePath)
  End If
  Application.ScreenUpdating = False
  For i = 2 to lRow
    ExtBk.Worksheets("EXPORTED").Cells(i, 4).Value = IntBk.Worksheets("DATA").Cells(i, 1).Value
    ExtBk.Worksheets("EXPORTED").Cells(i, 10).Formula = "=G" & i & "+H" & i & "-I" & i
  Next
  Set Rng1 = IntBk.Worksheets("DATA").Range("B2:E" & lRow)
  Set Rng2 = ExtBk.Worksheets("EXPORTED").Range("F2:I" & lRow)
  Rng1.Copy
  Rng2.PasteSpecial xlPasteValues
  Application.ScreenUpdating = True
  Application.DisplayAlerts = False
  ExtBk.Save
  ExtBk.Close
  Application.DisplayAlerts = True
End Sub
```


----------



## Hasson (Dec 19, 2022)

this  is  really much  better
thanks  very  much  for  your  help .


----------



## Flashbond (Dec 19, 2022)

Glad it did help


----------

