ioncila
12-11-2017, 09:45 AM
Hi
I'm trying to write code to copy all rows from a closed file (Closed.xlsx) that matches a named range ("TECH") in column 8 ("H").
Closed.xlsx is a file that is daily exported from a server with variable size each day (>100.000 rows).
Named range "TECH" belongs to destination book (Open.xlsm) and is also dynamic (contains some technicians names).
Sub CopyFromClosedBook()
Dim wsD As Worksheet, wsO As Worksheet
Application.ScreenUpdating = False
Set wsD = ThisWorkbook.Sheets("Report")
Set wsO = Workbooks.Open(".\Closed.xlsx").Sheets("DataList")
With wsO
.AutoFilterMode = False
.Range("A1:AB" & .Cells(Rows.Count, 1).End(3).Row).AutoFilter 8, "TECH"
If (.Range("A1:A" & .Range("A1").End(4).Row).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConsta nts).Count) > 1 Then
.Range("A2:AB" & .Cells(Rows.Count, 1).End(3).Row).Copy
wsD.[A2].Insert Shift:=xlDown
.AutoFilterMode = False
Else: MsgBox "File Not Found"
End If
End With
ActiveWorkbook.Close SaveChanges:=False
wsD.Range("A2:AB" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Columns:=1, Header:=xlNo
ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub
I searched in google and in other sources somthing that suits my need, bur no success.
Can you help me please?
Tnak you so much in advance
I'm trying to write code to copy all rows from a closed file (Closed.xlsx) that matches a named range ("TECH") in column 8 ("H").
Closed.xlsx is a file that is daily exported from a server with variable size each day (>100.000 rows).
Named range "TECH" belongs to destination book (Open.xlsm) and is also dynamic (contains some technicians names).
Sub CopyFromClosedBook()
Dim wsD As Worksheet, wsO As Worksheet
Application.ScreenUpdating = False
Set wsD = ThisWorkbook.Sheets("Report")
Set wsO = Workbooks.Open(".\Closed.xlsx").Sheets("DataList")
With wsO
.AutoFilterMode = False
.Range("A1:AB" & .Cells(Rows.Count, 1).End(3).Row).AutoFilter 8, "TECH"
If (.Range("A1:A" & .Range("A1").End(4).Row).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConsta nts).Count) > 1 Then
.Range("A2:AB" & .Cells(Rows.Count, 1).End(3).Row).Copy
wsD.[A2].Insert Shift:=xlDown
.AutoFilterMode = False
Else: MsgBox "File Not Found"
End If
End With
ActiveWorkbook.Close SaveChanges:=False
wsD.Range("A2:AB" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Columns:=1, Header:=xlNo
ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub
I searched in google and in other sources somthing that suits my need, bur no success.
Can you help me please?
Tnak you so much in advance