Hello,
I managed (with some help from here ) to write a macro which automatize the copy/paste data from a closed workbook that I can select to another one. The final destination workbook is a bit heavy (ca 6 Mo), while the original workbook is quite light (50ko). I copy data from different columns in 2 different worksheet in the origin workbook and copy it into 2 different worksheets, different columns in destination workbook. I then also copy down formulas.
However to run the code, it takes between 30 and 40s, which I find quite long. If I would do all these operations manually, I would probably take the same amount of time.
I think my code is probably not efficient and I was wondering if you had suggestion to run it in a more efficient manner.
Thank you!
I managed (with some help from here ) to write a macro which automatize the copy/paste data from a closed workbook that I can select to another one. The final destination workbook is a bit heavy (ca 6 Mo), while the original workbook is quite light (50ko). I copy data from different columns in 2 different worksheet in the origin workbook and copy it into 2 different worksheets, different columns in destination workbook. I then also copy down formulas.
However to run the code, it takes between 30 and 40s, which I find quite long. If I would do all these operations manually, I would probably take the same amount of time.
I think my code is probably not efficient and I was wondering if you had suggestion to run it in a more efficient manner.
Thank you!
Code:
Sub MaJ_Data_Prod()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
'Copie les valeurs de l'onglet 1 (Returns Core) du fichier extérieur selectionné (OpenBook) vers onglet Returns Core du fichier cible
OpenBook.Sheets(1).Range("A3:C3").Select
Range(Selection, Selection.End(xlDown).Offset(-1)).Copy
ThisWorkbook.Worksheets("Returns Core").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Copie à partir de la 1ere ligne vide
OpenBook.Sheets(1).Range("D3:N3").Select
Range(Selection, Selection.End(xlDown).Offset(-1)).Copy
ThisWorkbook.Worksheets("Returns Core").Range("M" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Copie à partir de la 1ere ligne vide
'Copie les valeurs d'un onglet3 (Problem Solving) du fichier extérieur vers onglet Problem Solving du fichier cible
OpenBook.Sheets(3).Activate
OpenBook.Sheets(3).Range("A2:C2").Select
Range(Selection, Selection.End(xlDown).Offset(-1)).Copy
ThisWorkbook.Worksheets("Problem Solving").Activate
ThisWorkbook.Worksheets("Problem Solving").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Copie à partir de la 1ere ligne vide
OpenBook.Sheets(3).Activate
OpenBook.Sheets(3).Range("D2:J2").Select
Range(Selection, Selection.End(xlDown).Offset(-1)).Copy
ThisWorkbook.Worksheets("Problem Solving").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Copie à partir de la 1ere ligne vide
OpenBook.Close False
'AutofillDown des formules en A:G, K:L et X:Y de l'onglet Returns Core
ThisWorkbook.Worksheets("Returns Core").Activate
Range("A2:G2").Select
Selection.AutoFill Destination:=Range("A2:G" & Range("H" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Range("K2:L2").Select
Selection.AutoFill Destination:=Range("K2:L" & Range("H" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Range("X2:Y2").Select
Selection.AutoFill Destination:=Range("X2:Y" & Range("H" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
'Reproduction de la mise en forme
Rows("2:2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range(Selection, Selection.End(xlDown)).Select
'AutofillDown des formules en D:E et M:M de l'onglet Problem Solving
ThisWorkbook.Worksheets("Problem Solving").Activate
Range("D2:E2").Select
Selection.AutoFill Destination:=Range("D2:E" & Range("A" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Range("M2:M2").Select
Selection.AutoFill Destination:=Range("M2:M" & Range("A" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
'Reproduction de la mise en forme
Rows("2:2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range(Selection, Selection.End(xlDown)).Select
ThisWorkbook.Worksheets("Returns Core").Activate
End If
Application.ScreenUpdating = True
End Sub