Copy Specific Range of Cells to Another Sheet & Print to PDF

[jrjobe]

Hi All!

I have quite of bit of data on one worksheet and the way it is structured works great. What I am trying to do now is take some of that data that has a number >= 1 in cells A22:A115 and copy A22:B115 and J22:J115 to Sheet2 starting in A15. Any row without a number in A22:A115 would not be copied.

Once the data is copied to Sheet2, I want to print to PDF and save it to the desktop - this part I think I have figured out - sort of.

Here is the code I have now, but can't figure out how to get it to work the way I need it to:

Sub CopyCells()

Dim i As Integer
Dim Lastrow As Long

'Declaring variables
Dim rng As Range
Set rng = Range("A22:B115, J22:J115" & Lastrow)

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To Lastrow
        If Cells(i, 1).Value >= 1 Then
            Sheets("Sheet2").Cells(15, 1).Value = Sheets("Sheet1").Cells(i, 1).Value
            Sheets("Sheet2").Cells(15, 2).Value = Sheets("Sheet1").Cells(i, 2).Value
            Sheets("Sheet2").Cells(15, 3).Value = Sheets("Sheet1").Cells(i, 10).Value
        End If
    Next
End Sub

When I run the code, it only copies the last row with a number >=1 in column A of Sheet1 to Sheet2, instead of all of the rows that have a number >=1 in column A.

If I can get the above code to work, is there a way to integrate the below code to print the data to PDF, so when the code above is executed, it will copy/paste the data, then print to PDF 'Sheet2' all at once?

Sub print_to_pdf()

    Dim sPath As String

    sPath = Environ("userprofile") & "\Desktop\"

ActiveSheet.Range("A1:C40").ExportAsFixedFormat Type:=0, _
Filename:=sPath & "Exported Data" & "_" & Format(Now(), _
"yyyymmdd hhmmss"), Quality:=0, IncludeDocProperties:=False, _
openafterpublish:=True
End Sub

I really appreciate any help I can get with this!

 

[John_w]

When I run the code, it only copies the last row with a number >=1 in column A of Sheet1 to Sheet2, instead of all of the rows that have a number >=1 in column A.

Use an integer variable inside the If ... End If block to change the destination row, i.e. 15+n. Initialise the variable to 0 outside the loop and increment it after copying the cells.

is there a way to integrate the below code to print the data to PDF

Call print_to_pdf after the For ... Next loop.

 

[jrjobe]

Thank you very much @John_w! This is what I got - making much more progress than before - it is copying the cells with a number >= 1 between A22:B115 and J22:J115, but it is also copying everything above it within columns A, B and J as well. Any idea what I can modify or add to exclude everything from rows 1 - 21? I figured using Set rng would have done the trick, but I guess not.

The print function is working as well when I run the Copy macro! Thank you!

Sub CopyCells()

Dim i As Integer
Dim LastRow As Long

'Declaring variables
Dim rng As Range
Set rng = Range("A22:B115, J22:J115" & Lastrow)

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
i = 0
    For i = 1 To LastRow
        If Cells(i, 1).Value >= 1 Then
            Sheets("Sheet2").Cells(15 + n, 1).Value = Sheets("Sheet1").Cells(i, 1).Value
            Sheets("Sheet2").Cells(15 + n, 2).Value = Sheets("Sheet1").Cells(i, 2).Value
            Sheets("Sheet2").Cells(15 + n, 3).Value = Sheets("Sheet1").Cells(i, 10).Value
            n = n + 1
        End If
    Next
    Call print_to_pdf

End Sub

Here is a snippet of what it looks like after running the macro:

Book3.xlsx
	A	B	C	D
1	Job Reference Information
2	Date
3	Prepaired By
4	Billing Address
5	Job Name
6	Address
7	Living Area
8	Garage
9
10	EMAIL
11	PHONE
12
13
14	QTY.	DESCRIPTION	TOTAL
15	ESTIMATE
16	Import Date:	File Name:
17	44729	6-17-2022 .xlsx
18	Job Reference Information		Customer Price
19	Date		$ 2,179.75
20	Prepaired By		$ -
21	Billing Address		$ -
22	Job Name		$ -
23	Address		$ 3,389.37
24	Living Area
25	Garage		$ 5,569.12
26	EMAIL
27	PHONE
28	QTY.	DESCRIPTION	CUSTOMER TOTAL
29	1	4" RECESSED CAN LIGHT W/LED. LAMP & TRIM	$ -
30	3	4" WAFER LED LAMP & TRIM INCLUDED	$ -
31	7	6" RECESSED ADJUSTABLE EYE SLOPE LIGHT LED	$ -
32	8	6" WAFER LED LAMP & TRIM INCLUDED	$ -
33	8	INSTALL 4FT 2 LAMP LED WRAP FIXTURE	$ -
34	5	PREWIRE & INSTALL SURFACE MOUNT LIGHT FBO	$ -
35
Sheet2

This is what it "should" look like. Rows 15 - 20 should be the only data that gets copied over - as those rows are the ones with a number >=1 on Sheet1:

Book3.xlsx
	A	B	C	D
1	Job Reference Information
2	Date
3	Prepaired By
4	Billing Address
5	Job Name
6	Address
7	Living Area
8	Garage
9
10	EMAIL
11	PHONE
12
13
14	QTY.	DESCRIPTION	TOTAL
15	1	4" RECESSED CAN LIGHT W/LED. LAMP & TRIM	$ -
16	3	4" WAFER LED LAMP & TRIM INCLUDED	$ -
17	7	6" RECESSED ADJUSTABLE EYE SLOPE LIGHT LED	$ -
18	8	6" WAFER LED LAMP & TRIM INCLUDED	$ -
19	8	INSTALL 4FT 2 LAMP LED WRAP FIXTURE	$ -
20	5	PREWIRE & INSTALL SURFACE MOUNT LIGHT FBO	$ -
21
Sheet2

 

[jolivanes]

Try this. Change the "Test Report.pdf" to whatever it needs to be.

Sub Maybe_So()
Dim valArr, i As Long, j As Long, lr As Long
valArr = Worksheets("Sheet1").Range("A22:J115").Value
    For i = LBound(valArr) To UBound(valArr)
        If Not valArr(i, 1) >= 1 Then
            For j = 1 To 10
                valArr(i, j) = ""
            Next j
        End If
    Next i
    
Sheets("Sheet2").Range("A15").Resize(UBound(valArr, 1), UBound(valArr, 2)) = valArr

    With Sheets("Sheet2")
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Range("A15:A" & lr).Resize(, 10).SpecialCells(4).Delete Shift:=xlUp
            .Range("C15:I" & lr).Delete Shift:=xlToLeft
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                CreateObject("WScript.Shell").specialfolders("Desktop") & "\Test Report.pdf" _
                    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                        :=False, OpenAfterPublish:=False    "or True if you want
    End With
End Sub

 

[jrjobe]

@jolivanes thank you very much! This did the trick and is much cleaner than what I was trying to do. Thank you!!!

 

[jolivanes]

Thank you for the update and good luck.

 

[jrjobe]

Use an integer variable inside the If ... End If block to change the destination row, i.e. 15+n. Initialise the variable to 0 outside the loop and increment it after copying the cells.

Call print_to_pdf after the For ... Next loop.

@John_w I ended up reusing the code in another project that is kind of similar and discovered where the error was at:

I forgot to define the variable n as an integer - but in the original code, I wasn't getting an error - this time it gave me an error for the new project I'm working on. The new worksheet was a little more complicated as well, as the original data requires the columns to be reordered and then copied to the new sheet.

Overall, I got it to work, so thanks again for pointing me in this direction...I sure wish that variable error popped up the first time I tried it. So here is the final version of the original code that is now working:

Sub CopyCells()

Dim i As Integer
Dim LastRow As Long
Dim n As Integer 'this is what I forgot

'Declaring variables
Dim rng As Range
Set rng = Range("N3:Q349" & LastRow)

LastRow = Cells(Rows.Count, "P").End(xlUp).Row
n = 0

    For i = 1 To LastRow
        If Cells(i, 16).Value >= 1 Then
            n = n + 1 'this is required to be defined first, otherwise an error pops up
            Sheets("Sheet4").Cells(0 + n, 1).Value = Sheets("Sheet3").Cells(i, 14).Value
            Sheets("Sheet4").Cells(0 + n, 2).Value = Sheets("Sheet3").Cells(i, 16).Value
            Sheets("Sheet4").Cells(0 + n, 3).Value = Sheets("Sheet3").Cells(i, 15).Value
            Sheets("Sheet4").Cells(0 + n, 4).Value = Sheets("Sheet3").Cells(i, 17).Value
            
        End If
    Next

End Sub

 

[jolivanes]

Re Post #7.
This

Set rng = Range("N3:Q349" & LastRow)

should be this

Set rng = Range("N3:Q" & LastRow)

and this

LastRow = Cells(Rows.Count, "P").End(xlUp).Row

should be before this line

Set rng = Range("N3:Q" & LastRow)

In "n = 0" set the 0 (zero) to 1 (one) so you dont need "Cells(0 + n, 1)" just "Cells(n, 1)" and put the "n = n + 1" after the last "Sheets("Sheet4").Cells" line

 

[jrjobe]

@jolivanes thank you once again! That makes a lot more sense putting it in that order and setting the range as indicated. Recommended changes are made and all is well!