Simplify a macro

E

Einar

I’m working on a project and want to print out different pricelists depending
on postal code, without using Word. I need to copy values from a list of
name, address and postal code (A2:C30), paste it, print it and then move to
the next name in the list.

All information is stored in the same workbook. Prices in the Worksheet
called “price†and address inn “address†and some values and function in a
worksheet called “Intern forsideâ€. Each customer generates different prices
depending on his postal number. So – I want to print out different prices to
lots of customers, but in this example is only from adress!A2:C30

If I try to registry the macro manually I will look like this:

ex_macro Makro
' Makro registrert 22.08.2005 av eho
'

'
Sheets("adress").Select
Range("A2").Select
Selection.Copy
Sheets("Intern forside").Select
Range("B14").Select
ActiveSheet.Paste
Sheets("adress").Select
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Intern forside").Select
Range("B15").Select
ActiveSheet.Paste
Sheets("adress").Select
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Intern forside").Select
Range("B17").Select
ActiveSheet.Paste
Sheets("price").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("adress").Select
Range("A3").Select
Selection.Copy
Sheets("Intern forside").Select
Range("B14").Select
ActiveSheet.Paste
Sheets("adress").Select
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Intern forside").Select
Range("B15").Select
ActiveSheet.Paste
Sheets("adress").Select
Range("C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Intern forside").Select
Range("B17").Select
ActiveSheet.Paste
Sheets("price").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

‘and so on……….. until last customer line 30.


I know it has to be an easier way of doing this?
May bee someone can help me.

Einar
 
B

Bob Phillips

By removing all the selecting, your code can be simplified to

With Sheets("adress")
.Range("A2").Copy Sheets("Intern forside").Range("B14")
.Range("B2").Copy Sheets("Intern forside").Range("B15")
.Range("C2").Copy Sheets("Intern forside").Range("B17")
.Range("A3").Copy Sheets("Intern forside").Range("B14")
.Range("B3").Copy Sheets("Intern forside").Range("B15")
.Range("C3").Copy Sheets("Intern forside").Range("B17")
End With
Sheets("price").PrintOut Copies:=1, Collate:=True

Chucking in a loop for tghe whole range you can get

i = 14
With Sheets("adress")
For Each cell In Range("A2:C30")
cell.Copy Sheets("Intern forside").Range("B" & i)
i = i + 1
Next cell
End With
Sheets("price").PrintOut Copies:=1, Collate:=True


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
E

Einar

Thank you, Bob.
I have made some small arrangements, but have still trouble with the loop.

- I always want to paste the values in the same cells (B14:B19)
- I want to end the project at the end of the list (Sheet “Adressâ€a2:F??)

With your corrections the macro looks like this:

Sub Makro1_Print_out()

' Makro registrert 22.08.2005 av eho

With Sheets("Adress")
.Range("A2").Copy Sheets("Print").Range("B14")
.Range("B2").Copy Sheets("Print").Range("B15")
.Range("C2").Copy Sheets("Print").Range("B16")
.Range("D2").Copy Sheets("Print").Range("B17")
.Range("E2").Copy Sheets("Print").Range("B18")
.Range("f2").Copy Sheets("Print").Range("B19")

End With
Sheets("prisliste til kunde").PrintOut Copies:=1, Collate:=True

'Chucking in a loop for the whole range you can get (What does this means)

i = 14
With Sheets("adress")
For Each cell In Range("A2:f30")
cell.Copy Sheets("Print").Range("B" & i)
i = i + 1
Next cell
End With
Sheets("Prisliste til kunde").PrintOut Copies:=1, Collate:=True





End Sub

What is wrong?

Einar

Bob Phillips skrev:
 
B

Bob Phillips

Hi Einar,

I am not really sure what you mean by ... I always want to paste the values
in the same cells (B14:B19) ... Can you clarify?

In the meantime

iLastRow = Cells.Find(What:="*", _
After:=Range("A2"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

i = 14
With Sheets("adress")
For Each cell In Range("A2:f" & iLastRow)
cell.Copy Sheets("Print").Range("B" & i)
i = i + 1
Next cell
End With


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
E

Einar

What I mend was that (B14:B19) in sheet “print†are basis information’s for
each specific print and therefore were I want to paste new information every
time based on the list.

Tank you

Einar


Bob Phillips skrev:
 
B

Bob Phillips

Aah! Of course the print statement!

iLastRow = Cells.Find(What:="*", _
After:=Range("A2"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

i = 14
With Sheets("adress")
For Each cell In Range("A2:f" & iLastRow)
cell.Copy Sheets("Print").Range("B" & i)
i = i + 1
If i = 20 Tnen
Worksheets("print").PrintOut Copies:=1, Collate:=True
i = 14
End If
Next cell
End With


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
E

Einar

Thank you Bob, but I’m sorry.
This macro takes the next row (and not the next line in “Adressâ€) and pastes
it in the next range in the target sheet. Instead of paste it in B14:19, it
will paste next time in B20:B26, B27:31 ………

Thank you again, for helping me.

Einar

The whole macro looks like this:

Sub Makro1_Print_out()

With Sheets("Adress")
.Range("A2").Copy Sheets("Print").Range("B14")
.Range("B2").Copy Sheets("Print").Range("B15")
.Range("C2").Copy Sheets("Print").Range("B16")
.Range("D2").Copy Sheets("Print").Range("B17")
.Range("E2").Copy Sheets("Print").Range("B18")
.Range("f2").Copy Sheets("Print").Range("B19")

End With
Sheets("prisliste til kunde").PrintOut Copies:=1, Collate:=True

iLastRow = Cells.Find(What:="*", _
After:=Range("A2"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

i = 14
With Sheets("adress")
For Each cell In Range("A2:f" & iLastRow)
cell.Copy Sheets("Print").Range("B" & i)
i = i + 1
If i = 20 Then
Worksheets("Prisliste til kunde").PrintOut Copies:=1,
Collate:=True
i = 14
End If
Next cell
End With

End Sub


Bob Phillips skrev:
 
E

Einar

Hi Bob.
It finally did work. I have made some corrections and now it functions as I
hoped.

Thank you.

Is it an easy way to make a break after every 15th print out, and then
verify the next 15th?

Einar

The finally macro:
Sub Makro1_Print_out()

' Makro1 Makro
' Makro registrert 22.08.2005 av eho

Sheets("Adress").Select

With Sheets("Adress")
.Range("A2").Copy Sheets("Print").Range("B14")
.Range("B2").Copy Sheets("Print").Range("B15")
.Range("C2").Copy Sheets("Print").Range("B16")
.Range("D2").Copy Sheets("Print").Range("B17")
.Range("E2").Copy Sheets("Print").Range("B18")
.Range("f2").Copy Sheets("Print").Range("B19")

End With
Sheets("prisliste til kunde").PrintOut Copies:=1, Collate:=True

iEndRow = Sheets("Adress").Cells(Rows.Count, "A") _
.End(xlUp).Row

'refers to the last cell in column A. Then, the .End(xlUp) causes
'Excel to scan upwards until a non-empty cell is found. The .Row
'property returns the row number of that last cell.

i = 14

With Sheets("Adress")
For Each cell In Range("A2:f" & iEndRow)
cell.Copy Sheets("Print").Range("B" & i)
i = i + 1
If i = 20 Then
Worksheets("Prisliste til kunde").PrintOut Copies:=1,
Collate:=True
i = 14
End If
Next cell
End With

End Sub


Einar skrev:
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Brake in a loop 2
Macro Loop 0
Help me5 1
Auto Fill Columns A and B with varying ranges 6
compile error, need to simplify/shorten 2
Help me4 2
Different Results from the Same Macro 3
Macro to fill to next field with data 4

Top