+ Reply to Thread
Results 1 to 2 of 2

Optimize/Speed up macro in large data file when copying data and pasting betw. wbooks

Hybrid View

  1. #1
    Registered User
    Join Date
    04-02-2011
    Location
    Espoo
    MS-Off Ver
    Excel 2007
    Posts
    16

    Optimize/Speed up macro in large data file when copying data and pasting betw. wbooks

    Hi,

    I have very large data file (wb1) around 50000 rows of data and 65 columns and I am trying to make a macro based on user input which is used to find correct rows from the data file and then copy and paste data of these rows to an other workbook.

    User has 3 workbooks open; one contains the data (wb1), one contains the macro and user input form (wb2) and the third is a target for copying data from the data workbook (wb3).

    So user inputs digit in wb2 and starts the macro. Then macro looks for this digit in certain column in wb1 and when finds the digit, copies values from several columns of the same row to first blank row and certain columns in wb2. The amount of possible rows is not known and can be just a few or thousands.

    My macro works fine when testing with small amounts of data but otherwise it is kind of slow and jams the computer. I'm just a beginner and I would appreciate if someone professional could just check the macro through and maybe suggest some corrections.

    Here is the macro:

    Sub CopyAndPaste()
    '
    Dim row, column As Integer
    Dim area, eCode As Excel.Range
    Dim name1, name2, name3, name4, name5 As String
    
    name2 = Workbooks("wb2").Worksheets("cover sheet").Range("B4").Value
    name3 = Workbooks("wb2").Worksheets("cover sheet").Range("B5").Value
    name4 = Workbooks("wb2").Worksheets("cover sheet").Range("B6").Value
    name5 = Workbooks("wb2").Worksheets("cover sheet").Range("B7").Value
    
    
    Set area = Workbooks("wb1").Worksheets("BG120").Range("A2:BM56500")
    Set eCode = Workbooks("wb2").Worksheets("cover sheet").Range("B3")
    
    row = 1
    column = 5
    
    Do
        row = row + 1
            If area.Cells(row, column) = eCode Then
                area.Cells(row, column + 32).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
                area.Cells(row, column + 58).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1)
                area.Cells(row, column + 53).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 5).End(xlUp).Offset(1)
                area.Cells(row, column + 19).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 6).End(xlUp).Offset(1)
                area.Cells(row, column + 18).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 8).End(xlUp).Offset(1)
                area.Cells(row, column + 54).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 9).End(xlUp).Offset(1)
                area.Cells(row, column + 17).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 10).End(xlUp).Offset(1)
                area.Cells(row, column + 43).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 12).End(xlUp).Offset(1)
                area.Cells(row, column + 16).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 18).End(xlUp).Offset(1)
                area.Cells(row, column + 48).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 20).End(xlUp).Offset(1)
                area.Cells(row, column + 44).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 21).End(xlUp).Offset(1)
                area.Cells(row, column + 45).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 22).End(xlUp).Offset(1)
                area.Cells(row, column + 56).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 23).End(xlUp).Offset(1)
                area.Cells(row, column + 57).Copy Destination:=Workbooks("wb3").Worksheets("Sheet1").Cells(Rows.Count, 24).End(xlUp).Offset(1)
            End If
    Loop Until area.Cells(row, column) = ""
    
    Windows("wb3").Activate
    Workbooks("wb3").Worksheets("Sheet1").Range("L:L").Select
    Selection.NumberFormat = "d.m.yyyy"
    Workbooks("wb3").Worksheets("Sheet1").Range("R:R").Select
    Selection.NumberFormat = "d.m.yyyy"
    Workbooks("wb3").Worksheets("Sheet1").Range("A1").Select
    
    name1 = Workbooks("wb3").Worksheets("sheet1").Range("A2").Value
    ActiveWorkbook.SaveAs Filename:=name1 & "_" & name2 & "_" & name3 & "_" & name4 & "_" & name5 & "_" & Format(Date, "ddmmyyyy")
    
    End Sub
    I guess it is quite simple but is it best possible...?

  2. #2
    Forum Expert
    Join Date
    11-29-2010
    Location
    Ukraine
    MS-Off Ver
    Excel 2019
    Posts
    4,168

    Re: Optimize/Speed up macro in large data file when copying data and pasting betw. wb

    hi, sepi, it would be helpful to see workbooks: wb1,wb2,wb3

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1