Do I need a, do loop?

Hi

Can you please attach an example file showing your source and output data and what goes where. There are a couple of bits missing in the code (eg the first output cell) and are you pasting just the values or are they formulas?

rylo

You do not need to "SELECT" everything in Excel.
That being said, I've shortened your code and added a loop to get everything (you may want to confirm my TO and FROM ranges)...

Sub Macro4444()
'
' Macro4444 Macro
' Macro recorded 13/05/2009 by D
'
' Keyboard Shortcut: Ctrl+d
'
    
   Dim iRow As Long
    iRow = 2
    Sheets("Sheet3").Select
    Do Until IsEmpty(Sheets("Sheet3").Range("A" & iRow)) = True
        Sheets(" Print Forms").Range("F42:I42, I49, F40, F42").Value = _
            Sheets("Sheet3").Range("A" & iRow & ":D" & iRow & ", G" & iRow & ", F" & iRow & ", E" & iRow).Value
        Sheets(" Print Forms").PrintOut Copies:=1, Collate:=True
        iRow = iRow + 1
        Range("A" & iRow).Select
    Loop
End Sub

Originally Posted by Chance2

You do not need to "SELECT" everything in Excel.
That being said, I've shortened your code and added a loop to get everything (you may want to confirm my TO and FROM ranges)...

Sub Macro4444()
'
' Macro4444 Macro
' Macro recorded 13/05/2009 by D
'
' Keyboard Shortcut: Ctrl+d
'
    
   Dim iRow As Long
    iRow = 2
    Sheets("Sheet3").Select
    Do Until IsEmpty(Sheets("Sheet3").Range("A" & iRow)) = True
        Sheets(" Print Forms").Range("F42:I42, I49, F40, F42").Value = _
            Sheets("Sheet3").Range("A" & iRow & ":D" & iRow & ", G" & iRow & ", F" & iRow & ", E" & iRow).Value
        Sheets(" Print Forms").PrintOut Copies:=1, Collate:=True
        iRow = iRow + 1
        Range("A" & iRow).Select
    Loop
End Sub

Thank very much for you time and help
I changed a range (F42:I42) to (D49-G49) , but for some reason i cannot work out how to alter:

I need
'Sheet3' column G (Missing or Free Text) copied into sheet 'Print Forms' cell I49
'Sheet3' column E (DATE) copied in to 'Print Forms' cell F42
'Sheet3' column F (0000) copies in to 'Print Forms' cell F40

I hope this makes sense, and again i do thank you for your time and help.

The lines after the DO statement are your TO and FROM:

"TO"
Sheets(" Print Forms").Range("F42:I42, I49, F40, F42").Value

"FROM"
Sheets("Sheet3").Range("A" & iRow & ":D" & iRow & ", G" & iRow & ", F" & iRow & ", E" & iRow).Value

I changed a range (F42:I42) to (D49-G49) , but for some reason i cannot work out how to alter:

I need
'Sheet3' column G (Missing or Free Text) copied into sheet 'Print Forms' cell I49
'Sheet3' column E (DATE) copied in to 'Print Forms' cell F42
'Sheet3' column F (0000) copies in to 'Print Forms' cell F40

Sheets(" Print Forms").Range("D49:G49, I49, F40, F42").Value = _
Sheets("Sheet3").Range("A" & iRow & ":D" & iRow & ", G" & iRow & ", F" & iRow & ", E" & iRow).Value

Originally Posted by Chance2

The lines after the DO statement are your TO and FROM:

"TO"
Sheets(" Print Forms").Range("F42:I42, I49, F40, F42").Value

"FROM"
Sheets("Sheet3").Range("A" & iRow & ":D" & iRow & ", G" & iRow & ", F" & iRow & ", E" & iRow).Value



Sheets(" Print Forms").Range("D49:G49, I49, F40, F42").Value = _
Sheets("Sheet3").Range("A" & iRow & ":D" & iRow & ", G" & iRow & ", F" & iRow & ", E" & iRow).Value

Sorry to be a complete pain but;
This does not seem to work, as in sheet 'Print Forms' cells I49 , F40 and F42.
When printed is has data from sheet 'Sheet3' Column A inputed in to each of the above cells.

so the data gets reapted from Column A.

Sorry about that, you are right the .Value only gets the first range.
Try this...

Sub Macro4444()
'
' Macro4444 Macro
' Macro recorded 13/05/2009 by D
'
' Keyboard Shortcut: Ctrl+d
'
    
   Dim iRow As Long
    iRow = 2
    Sheets("Sheet3").Select
    Do Until IsEmpty(Sheets("Sheet3").Range("A" & iRow)) = True
        Sheets("Sheet3").Range("A" & iRow & ":D" & iRow).Copy Sheets(" Print Forms").Range("D49:G49")
        Sheets("Sheet3").Range("G" & iRow).Copy Sheets(" Print Forms").Range("I49")
        Sheets("Sheet3").Range("F" & iRow).Copy Sheets(" Print Forms").Range("F40")
        Sheets("Sheet3").Range("E" & iRow).Copy Sheets(" Print Forms").Range("F42")
        Sheets(" Print Forms").PrintOut Copies:=1, Collate:=True
        iRow = iRow + 1
        Range("A" & iRow).Select
    Loop
End Sub