Create a new workbook copying some data with macro

Question

In my worksheet, containing over 2k Rows, I need to create a macro that would automatically open another file, and then would copy some of the data from the first worksheet in the selected row to specific cell in the newly created/opened file

I've tried the following code, but it seems to stuck at the first copying action (TECHNICAL SHEET-2020v2.xlsm is the newly created file, and Suivi Nouveautés 2020.xlsx is the actual worksheet in which I need to make the macro, and in which are the data I need to copy

Sub CREERTS()
'
' CREERTS Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+T
'

Dim RowNo As Long

Workbooks.Open Filename:= _
    "Myserveradress/filename.xlsm"
ActiveWindow.Visible = False
Windows("TECHNICAL SHEET-2020v2.xlsm").Visible = True
Sheets("SPECIFICATION").Select
ActiveWindow.SmallScroll Down:=-60
Range("C12:J12").Select
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 12
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("J" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("B6:B7").Paste
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("Q" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("F8:H11").Paste
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("O" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("B8:C11").Paste
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("F" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("A13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("S" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("T" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E37").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("U" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E38").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("AF" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End Sub

Can you be a bit more specific about your problem - error messages etc? — SJR, Apr 17 '19 at 14:38
it's error '438' hopefully it'll help you understand my issue — nicmdm, Apr 17 '19 at 15:37

score 0 · Answer 1 · answered Apr 17 '19 at 14:47

0

Did you declare the value of RowNo?

You can optimize your code using Application.ScreenUpdating = False and Application.Calculation = xlCalculationManual in the beginning and Application.ScreenUpdating = True and Application.Calculation = xlCalculationAutomatic in the end of code.

Also you can delete all those ActiveWindow.ScrollCollumn statements. They are useless.

answered Apr 17 '19 at 14:47

Pedro Nunes

28
6

I've indeed ommit to declare the value of RowNo. I've also added the calculation thing u typed. Now macro work for copying the selected cell, but it is now stuck at copying it, any idea? – nicmdm Apr 17 '19 at 15:21
Ok, i've solved it by changing .Paste by .PasteSpecial xlPasteAll – nicmdm Apr 17 '19 at 16:00
`.paste` is not a method. you can use `.PasteSpecial`. Or you can use `Range("J"& RowNo).Copy (Workbooks("TECHNICAL SHEET-2020v2.xlsm").Sheets(your_sheet).Range("B6"))` besides all those `activate` and `paste` thing. – Pedro Nunes Apr 17 '19 at 16:08
Thanks a lot for your help. I am now able to create the new file. But it works only if I execute the macro direclty from VBA, the shortcut selected only do half the job (create the file, but don't fill anything), any idea? – nicmdm Apr 17 '19 at 17:03
You're welcome. Please update your question with the new code. – Pedro Nunes Apr 17 '19 at 17:22

score 0 · Answer 2 · answered Apr 17 '19 at 21:06

I've solved almost all of my issue. The macro (code below) is working perfeclty, though taking quite some time, due to the amount of processing I guess However, the only way to perform the macro completely is to do it from VBA directly. If I use the shortcut Ctrl+Shift+T that I've specified, the maccro stop after opening the file, there is no data copied, no saving file... Any idea of why?

Sub CREERTS() ' ' CREERTS Macro ' ' Touche de raccourci du clavier: Ctrl+Shift+T '

Dim RowNo As Long
RowNo = Selection.Row '<- Here you get the row number you have select

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Workbooks.Open FileName:= _
    "\\MYSERVERADRESS\filename.xlsm"
ActiveWindow.Visible = False
Windows("TECHNICAL SHEET-2020v2.xlsm").Visible = True
Sheets("SPECIFICATION").Select
Range("B6:B7").Select
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("J" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("B6:B7").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("K" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E6").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("R" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("F8:H11").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("P" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("B8:C11").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("Y" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("J5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("Z" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("J6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("AB" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("J9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("AE" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("J10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("F" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("A13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("G" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("A16").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("T" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("U" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E37").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("V" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E38").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("AH" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("J1") = Date

Dim FilePath As String
Dim FileName As String


FilePath = "MyfolderIwanttosavethefileto"
FileName = "TS-DEV" & "-" & Range("A13") & "-" & Range("B6") & "-" & Format(Now(), "YYYY-MM-DD")

'It saves .PDF file at your Descrop with the name of the worksheet
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=FilePath & FileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
ActiveWorkbook.Close

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Create a new workbook copying some data with macro

2 Answers2