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...?
Bookmarks