Copy from sheet 1 to sheet 2, print sheet 2, row down, sheet 1 copy to 2, print 2...etc

[yksvohcurteiP]

Hello,

I m kinda lost. Coulnd't find sollution here so posting new one, hoping someone will help.
What I need is to copy data from row number 1 (sheet1) to specific cells in sheet2. Looks like this:

sh_1.Activate
    sh_1.Range("B2").Select
    Selection.Copy
    sh_2.Activate
    sh_2.Range("A1:A3").PasteSpecial

    sh_1.Activate
    sh_1.Range("H2").Select
    Selection.Copy
    sh_2.Activate
    sh_2.Range("D8:J8").PasteSpecial

    sh_1.Activate
    sh_1.Range("F2").Select
    Selection.Copy
    sh_2.Activate
    sh_2.Range("B5:C5").PasteSpecial

As you can see, sh_1 cells are from row 2. Copy is done, then sheet 2 (sh_2) is going to print itself. Printed. Great.
Now it should go back to sheet1, go one row down, copy and paste to targeted cells. So:

sh_1.Activate
    sh_1.Range("B3").Select
    Selection.Copy
    sh_2.Activate
    sh_2.Range("A1:A3").PasteSpecial

    sh_1.Activate
    sh_1.Range("H3").Select
    Selection.Copy
    sh_2.Activate
    sh_2.Range("D8:J8").PasteSpecial

    sh_1.Activate
    sh_1.Range("F3").Select
    Selection.Copy
    sh_2.Activate
    sh_2.Range("B5:C5").PasteSpecial

How can I make it to go down? Do not want to use Offset.

I have last row set up like this:

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

But how do I loop it so it copies, prints, row down, copies, print, until last row?

If there is similar thread, I am sorry, but honestly - I've searched. Maybe I am a dummy and couldn't fit one.

 

[yksvohcurteiP]

Anyone? Don't tell me that this task is too much for you!
Really, need help..

 

[yksvohcurteiP]

Okay, I did it. You can find it below (intrested ppl).

Sub druk()


Dim wb As Workbook
Dim sh_sheet1 As Worksheet
Dim sh_sheet2 As Worksheet
Dim RowOffset As Long
Dim LastRow As Long

RowOffset = 3

Set wb = ActiveWorkbook
Set sh_sheet1 = wb.Worksheets("Sheet1")
Set sh_sheet2 = wb.Worksheets("Sheet2")



'RowOffset = sh_sheet1.Cells(sh_sheet1.Rows.Count, "A").End(xlUp).Row


sh_sheet2.Range("C4").Value = sh_sheet1.Range("A1").Value



Application.ScreenUpdating = False

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

'''''''''''''''''''''''''''' COPY '''''''''''''''''''''''''''''

For i = 3 To LastRow
        sh_sheet2.Range("A1:A3").Value = sh_sheet1.Range("B" & RowOffset).Value
        sh_sheet2.Range("B5:C5").Value = sh_sheet1.Range("F" & RowOffset).Value
        sh_sheet2.Range("E5").Value = sh_sheet1.Range("G" & RowOffset).Value
        sh_sheet2.Range("C6:J7").Value = sh_sheet1.Range("C" & RowOffset).Value
         sh_sheet2.Range("D8:J8").Value = sh_sheet1.Range("H" & RowOffset).Value
    RowOffset = RowOffset + 1
    
'''''''''''''''' PRINT IF'''''''''''''''''''''''''''''

        If sh_sheet2.Range("D8").Value Like "Talk" Or _
            sh_sheet2.Range("D8").Value Like "Ogniotrwałe włókna ceramiczne" Or _
            sh_sheet2.Range("D8").Value Like "Węglik krzemu, niewłóknisty - frakcja wdychalna" Or _
            sh_sheet2.Range("D8").Value Like "Krzemionka krystaliczna - kwarc, krystobalit - frakcja respirabilna" Or _
            sh_sheet2.Range("D8").Value Like "Węglik krzemu, niewłóknisty - frakcja wdychalna Krzemionka krystaliczna - kwarc, krystobalit - frakcja respirabilna" Or _
            sh_sheet2.Range("D8").Value Like "Ogniotrwałe włókna ceramiczne Krzemionka krystaliczna - kwarc, krystobalit - frakcja respirabilna" Or _
            sh_sheet2.Range("D8").Value Like "Sztuczne włókna mineralne, z wyjątkiem ogniotrwałych włókien ceramicznych - włókna respirabilne" Then
            
                sh_sheet2.Activate
                ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        End If
            
Next i

sh_sheet1.Activate
    
End Sub