Results 1 to 2 of 2

Thread: Copying data between two Excel files

  1. #1

    Copying data between two Excel files



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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

  2. #2

    SOLVED: Copying data between two Excel files

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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •