Copying data between two Excel files

dorindanci

New member
Joined
May 10, 2014
Messages
2
Reaction score
0
Points
0
Hi,
I am trying to copy several filtered columns from an Excel file to another.
I have the code to do this, but I think it needs some refinement (or re-written from scratch?!).
I think that when I copy data from a column (source file) to another column (destination file), it copies the entire column (row 1 to row 1,048,576) and then the calculations in the destination file are slow (the processors are working hard even when I do only banal tasks like filtering or data input).
Is there a way so when I copy data, only the visible and non-blank data is copied, OR a way for the code to determine the entire range of the source spreadsheet with data to be copied, and then only those cells are being copied?
ANY OTHER APPROACH IS WELCOMED

Source file: Sale_Report.xlsx (Detail tab)
Destination file: Curve Creation Tool.xlsm
- Input tab: Import Sales button (macro)
- Data tab: data copied from Detail spreasdsheet
If you need the files, send me an email to holograful at gmail dot com, and I will attach them.
Thank you.
Issues:
To refine or re-write this:
'Clear Data in the Curve Creation Tool
wShtData.Range("A2:S2000").Clear
wShtData.Range("U2:X2000").Clear
wShtData.Range("Z2:AO2000").Clear
To refine or re-write this:
'Copy data from Extract to Curve Creation Tool
With Workbooks(FileName)
.Sheets("Detail").Columns("A:A").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("A1")
.Sheets("Detail").Columns("C:K").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("B1")
.Sheets("Detail").Columns("S:S").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("K1")
.Sheets("Detail").Columns("L:M").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("L1")
.Sheets("Detail").Columns("Z:AC").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("z1")
.Sheets("Detail").Columns("AD:AG").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("U1")
.Sheets("Detail").Columns("AH:AH").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AE1")
.Sheets("Detail").Columns("AI:AI").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AD1")
.Sheets("Detail").Columns("AJ:AO").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AF1")
.Sheets("Detail").Columns("AZ:BA").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AL1")
.Sheets("Detail").Columns("BE:BE").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AN1")
.Sheets("Detail").Columns("BI:BI").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AO1")
.Sheets("Detail").Columns("BK:BM").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("Q1")
.Sheets("Detail").Columns("AP:AR").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("N1")
End With
See the entire code below:
Code:
'Option Explicit
Sub ImportSales()
'
'ImportSales Macro
Application.EnableEvents = False
Application.EnableAnimations = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim wbkCurveCreationTool As Workbook
Dim wShtData As Worksheet
Set wbkCurveCreationTool = Workbooks("Curve Creation Tool.xlsm")
Set wShtData = wbkCurveCreationTool.Sheets("Data")
'Clear Data in the Curve Creation Tool
wShtData.Range("A2:S2000").Clear
wShtData.Range("U2:X2000").Clear
wShtData.Range("Z2:AO2000").Clear
MsgBox "Importing may take around 2 minutes"
' use the file open dialog to find the file
FileToOpen = Application.GetOpenFilename _
    (Title:="Please choose a file to import", _
    FileFilter:="Excel Files *.xls? (*.xls?),")
If FileToOpen = False Then
    MsgBox "No file specified.", vbExclamation, "Please Try Again"
Exit Sub
Else
    Workbooks.Open FileName:=FileToOpen
    Range("A1").Select
End If
FileName = Mid(FileToOpen, InStrRev(FileToOpen, "\") + 1)
'Dim FileName1 As Workbooks
'Dim wShtDetail As Worksheet
'Set FileName1 = Workbooks(FileName)
'Set wShtDetail = FileName.Sheets("Detail")
'Copy data from Extract to Curve Creation Tool
With Workbooks(FileName)
    .Sheets("Detail").Columns("A:A").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("A1")
    .Sheets("Detail").Columns("C:K").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("B1")
    .Sheets("Detail").Columns("S:S").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("K1")
    .Sheets("Detail").Columns("L:M").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("L1")
    .Sheets("Detail").Columns("Z:AC").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("z1")
    .Sheets("Detail").Columns("AD:AG").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("U1")
    .Sheets("Detail").Columns("AH:AH").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AE1")
    .Sheets("Detail").Columns("AI:AI").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AD1")
    .Sheets("Detail").Columns("AJ:AO").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AF1")
    .Sheets("Detail").Columns("AZ:BA").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AL1")
    .Sheets("Detail").Columns("BE:BE").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AN1")
    .Sheets("Detail").Columns("BI:BI").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("AO1")
    .Sheets("Detail").Columns("BK:BM").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("Q1")
    .Sheets("Detail").Columns("AP:AR").SpecialCells(xlCellTypeVisible).Copy wShtData.Range("N1")
End With
    'Close extract
    Workbooks(FileName).Close False
    
    'Format Sale Date field
    wShtData.Range("AL:AL").NumberFormat = "dd/mm/yyyy"
    
    Application.Goto Worksheets("Data").Range("A1"), True
    
    'Save Curve Creation Tool
    ThisWorkbook.Save
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.EnableAnimations = True
End Sub
 

dorindanci

New member
Joined
May 10, 2014
Messages
2
Reaction score
0
Points
0
SOLVED: Copying data between two Excel files

To see the SOLUTION, go to MrExcel forum and look for Copying data between two Excel files.
 
Top