1

I already have code to do what I want, but I would like it faster.

I copied a row from a cell, then the VBA changes the sheet, selects the row and paste the selection I copied, then saves the sheet as a PDF.

Sub Sheet2()
    Selection.Copy
    Sheets("Sheet2").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Dim Path As String
    Dim Sect As String
    Dim Sectslash As String
    Dim fisier As String
    Dim director As String
    Path = "C:\work"
    Sect = Range("X1")
    Sectslash = Range("X1") & "\"
    fisier = Range("A1")
    director = Path & Sectslash
    If Dir(Path & Sectslash, 16) <> vbNullString Then
    Else
    MkDir director
    End If
If IsEmpty(Range("B1")) = True Then
    ActiveSheet.Copy
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close False
    Sheets("Sheet1").Select
    ActiveCell.Offset(1, 0).EntireRow.Select
Else
    Sheets("Sheet3").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    ActiveSheet.Copy
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & uatslash & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close False
    Sheets("Sheet1").Select
    ActiveCell.Offset(1, 0).EntireRow.Select
End If
End Sub

*This is the one that doesn`t work (The line Sheets("Sheet2").Rows("1.1").Paste is not ok ): i am trying to make it faster ... i want to paste the selection to sheet2 in the first row , but without selecting the sheet2 , and save the sheet2 as PDF. i have a good code but slow , than i have what i tryed to do ... but is not working *

Sub Sheet2()
    Selection.Copy
    Sheets("Sheet2").Rows("1.1").Paste
    Dim Path As String
    Dim Sect As String
    Dim Sectslash As String
    Dim fisier As String
    Dim director As String
    Path = "C:\work\"
    Sect = Sheets("Sheet2").Range("X1")
    Sectslash = Sheets("Sheet2").Range("X1") & "\"
    fisier = Sheets("Sheet2").Range("A1")
    director = Path & Sectslash
    If Dir(Path & Sectslash, 16) <> vbNullString Then
    Else
    MkDir director
    End If
If IsEmpty(Sheets("Sheet2").Range("B1")) = True Then
    Sheets("Sheet2").Copy
    Sheets("Sheet2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close False
    ActiveCell.Offset(1, 0).EntireRow.Select
Else
    Selection.Copy Sheets("Sheet3").Rows("1:1").Paste
    Sheets("Sheet3").Copy
    Sheets("Sheet3").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & uatslash & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close False
    ActiveCell.Offset(1, 0).EntireRow.Select
End If
End Sub
Mayukh Bhattacharya
  • 12,541
  • 5
  • 21
  • 32
  • 3
    Anytime you use Select/Activate/Copy/Paste it's going to be slower than just assigning values to the places where you want them.... read up on the suggestions here: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – braX Apr 18 '23 at 21:30
  • 2
    You also have many references to ranges that are not qualified with their sheet, which is going to get really confusing if it isn't already. `Sect = Range("X1")` for example. – braX Apr 18 '23 at 21:31

2 Answers2

1

Instead of

Selection.Copy
Sheets("Sheet2").Rows("1.1").Paste

Use

Sheets("Sheet2").Range("1:1") = Selection.Value

The code runs instantly on my test with empty Excel sheets. What do you consider slow?

If you have a lot of content on Sheet2 and you are saving it to a pdf file, it will take time, but that has nothing to do with your code and cannot be sped up by using VBA.

How long does it take to save your file manually if you do it through file > save as > save as type pdf? VBA cannot make Excel work any faster than that.

How long does it take if you start with a blank workbook, empty Sheet2, and only have values in Sheet1 Ranges A1 an X1? That is how fast the code is running. Anything longer than that is due to the content of Sheet2.

kevin
  • 1,357
  • 1
  • 4
  • 10
  • it takes almost 1 second , because it changes the sheet , than prints it as PDF , than changes the sheet again ... I have more than 1000 rows , for each row i have to make a PDF – Munteanu George Apr 19 '23 at 06:22
  • The code I gave above will eliminate changing the sheet - is it much faster? As others have replied above, you also have to worry about the time it takes to select the next row, and the Sheets("Sheet2").Copy line, both of which are probably unnecessary. The code as you have written it isn't looping through any rows. If you can include the rest of your code, it can probably be revised to avoid the EntireRow.Select and Sheet.Copy. – kevin Apr 19 '23 at 06:45
  • the problem is that the row that i copy is changing every time with ActiveCell : ActiveCell.Offset(1, 0).EntireRow.Select (at the end of the vba code , and when i don`t use ActiveCell it gives me an error to Sheets("Anexa2").Rows("1.1").Paste . if i don`t use activesheet , i have to change everything . How can i give you the whole file .xlsx ? – Munteanu George Apr 19 '23 at 07:26
  • Have you tried using the above code? Is it much faster? There is no problem with replacing the ActiveCell.Offset(1,0).EntireRow.Select, you just need to tell us how you are actually using the code. Are you calling this sub from another sub? Are you manually starting this sub 1,000 times for each row on your sheet? You cannot give the whole file, and you don't need to. You can just post all of the code you are using. – kevin Apr 19 '23 at 17:02
  • i use another program , to start it every 100miliseconds or 1 second ... depending how fast it`s moving . i used a shortcut for the code (CRTL+SHIFT+i) and start it with this software Autohotkey that has another shortcut (F9) for this command : '$F9:: Loop { if not GetKeyState("F9", "P") break SetTimer,PressTheKey, 1000 Return PressTheKey: Send, ^+i Return }' – Munteanu George Apr 21 '23 at 16:55
1

Your original code only runs on one row, and only creates one file. You haven't given any indication how you are looping through all of your rows, and you haven't given any indication of what you consider "fast" or "slow". The below will probably work, but it would help if you share all of your code, how fast it runs, and how fast you want it to run.

This code will run through all of your rows from row 1 until the first empty cell in Column A.

I have left the original unnecessary lines code in tact, but commented them out so they will not slow it down.

Sub Sheet2()

Dim LastRow As Long

LastRow = Sheets("Sheet1").Range("A1").End(xlDown).Row

For Each rg In Sheets("Sheet1").Range("A1:A" & LastRow)

    '    Selection.Copy
    '    Sheets("Sheet2").Rows("1.1").Paste
        Sheets("Sheet2").Range("1:1") = rg.EntireRow.Value
        
        Dim Path As String
        Dim Sect As String
        Dim Sectslash As String
        Dim fisier As String
        Dim director As String
        Path = "C:\work\"
        Sect = Sheets("Sheet2").Range("X1")
        Sectslash = Sheets("Sheet2").Range("X1") & "\"
        fisier = Sheets("Sheet2").Range("A1")
        director = Path & Sectslash
        If Dir(Path & Sectslash, 16) <> vbNullString Then
        Else
        MkDir director
        End If
    If IsEmpty(Sheets("Sheet2").Range("B1")) = True Then
'        Sheets("Sheet2").Copy
        Sheets("Sheet2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'        ActiveWorkbook.Close False
'        ActiveCell.Offset(1, 0).EntireRow.Select
    Else
        Selection.Copy Sheets("Sheet3").Rows("1:1").Paste
'        Sheets("Sheet3").Copy
        Sheets("Sheet3").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & uatslash & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'        ActiveWorkbook.Close False
'        ActiveCell.Offset(1, 0).EntireRow.Select
    End If

Next rg

End Sub
kevin
  • 1,357
  • 1
  • 4
  • 10
  • it gives me an error on Sheets("Sheet2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False – Munteanu George Apr 21 '23 at 10:35
  • i`t because LastRow starts with line 0 by default. my first row is 5 , i will try to hide or delete the first 4 lines and come back – Munteanu George Apr 21 '23 at 10:41
  • it worked after i deleted the first 4 lines (the head table) – Munteanu George Apr 21 '23 at 10:54
  • it worked ! it`s dissapointing , because it`s not faster , but at least i can use the computer while he is doing that in background. The code that i used , would not let me minimize the excel. I will not give up , i will try agan in with python . – Munteanu George Apr 21 '23 at 17:01