my first excel macro -how to make it better

M

milking

New Member
Joined
May 20, 2011
Messages
15
Hello, here is my very first macro, it takes values from sheet1 and adds it do diffrent sheets, but the user have to create the sheets manually,
blad is the swedish name for sheet


sub bynamn()

On Error GoTo HandleErr
'blad 2
'blad namn
Blad2.Name = Blad1.Range("C7")
Blad1.Range("C7").Copy Destination:=Blad2.Range("F4")
Blad1.Range("D7").Copy Destination:=Blad2.Range("B1")
/this row does not work becouse F40 is a sum of diffrent cells.
'Blad2.Range("F40").Paste Destination:=Blad1.Range("E7").Value

Blad3.Name = Blad1.Range("C8")
Blad1.Range("C8").Copy Destination:=Blad3.Range("F4")
Blad1.Range("D8").Copy Destination:=Blad3.Range("B1")
Blad4.Name = Blad1.Range("C9")
Blad1.Range("C9").Copy Destination:=Blad4.Range("F4")
Blad1.Range("D9").Copy Destination:=Blad4.Range("B1")
Blad5.Name = Blad1.Range("C10")
Blad1.Range("C10").Copy Destination:=Blad5.Range("F4")
Blad1.Range("D10").Copy Destination:=Blad5.Range("B1")
Blad6.Name = Blad1.Range("C11")
Blad1.Range("C11").Copy Destination:=Blad6.Range("F4")
Blad1.Range("D11").Copy Destination:=Blad6.Range("B1")
Blad7.Name = Blad1.Range("C12")
Blad1.Range("C12").Copy Destination:=Blad7.Range("F4")
Blad1.Range("D12").Copy Destination:=Blad7.Range("B1")
Blad8.Name = Blad1.Range("C13")
Blad1.Range("C13").Copy Destination:=Blad8.Range("F4")
Blad1.Range("D13").Copy Destination:=Blad8.Range("B1")

ExitHere:
Exit Sub
HandleErr:
Select Case Err.Number
Case Else
MsgBox Err.Description & " inga mer blad" & Err.Number
Resume ExitHere
End Select
End Sub
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
Hi and welcome. Very nice 1st macro.

Below is another way it could be done (english)
Code: 
Sub bynamn2()

    Dim cell As Range, ws As Worksheet
    
    For Each cell In Sheet1.Range("C7:C13")                 [COLOR="Green"]' Loop for each cell in Blad1 C7:C13[/COLOR]
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))    [COLOR="Green"]' Add new Blad[/COLOR]
        ws.Name = cell.Value                                [COLOR="Green"]' Name new Blad[/COLOR]
        ws.Range("F4").Value = cell.Value                   [COLOR="Green"]' Copy from Blad1 column C to new Blad F4[/COLOR]
        ws.Range("B1").Value = cell.Offset(, 1).Value       [COLOR="Green"]' Copy from Blad1 column D to new Blad B1[/COLOR]
        [COLOR="Green"]'ws.Range("F40").Value = cell.Offset(, 2).Value     ' ???[/COLOR]
    Next cell

End Sub

Forum Tip: Pasting VBA code in the forum editor
It would be best if you surround your VBA code with code tags e.g [CODE]your VBA code here[/CODE]
It makes reading your VBA code much easier.
When you're in the forum editor, highlight your pasted VBA code and then click on the icon with the pound or number sign #.
 
Upvote 0
AlphaFrog said:
Hi and welcome. Very nice 1st macro.

Below is another way it could be done (english)
Code: 
Sub bynamn2()
 
    Dim cell As Range, ws As Worksheet
 
    For Each cell In Sheet1.Range("C7:C13")                 [COLOR=green]' Loop for each cell in Blad1 C7:C13[/COLOR]
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))    [COLOR=green]' Add new Blad[/COLOR]
        ws.Name = cell.Value                                [COLOR=green]' Name new Blad[/COLOR]
        ws.Range("F4").Value = cell.Value                   [COLOR=green]' Copy from Blad1 column C to new Blad F4[/COLOR]
        ws.Range("B1").Value = cell.Offset(, 1).Value       [COLOR=green]' Copy from Blad1 column D to new Blad B1[/COLOR]
        [COLOR=green]'ws.Range("F40").Value = cell.Offset(, 2).Value     ' ???[/COLOR]
    Next cell
 
End Sub

Forum Tip: Pasting VBA code in the forum editor
It would be best if you surround your VBA code with code tags e.g [CODE]your VBA code here[/CODE]
It makes reading your VBA code much easier.
When you're in the forum editor, highlight your pasted VBA code and then click on the icon with the pound or number sign #.
Click to expand...

Code: 
 Set ws = Blad1.add(After:=Sheets(Sheets.Count))
i get a error , compilation error, this metod or datamember can not be found
the add value can not be found
i tried changing to sheet1.add but that does not work
 
Upvote 0
I think you only have to change just the one Sheet1 (red) to Blad1. All the rest of the code is the same but I really don't know for sure.

Code: 
Sub bynamn2()

    Dim cell As Range, ws As Worksheet
    
    For Each cell In [COLOR="Red"]Sheet1[/COLOR].Range("C7:C13")                 ' Loop for each cell in Blad1 C7:C13
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))    ' Add new Blad
        ws.Name = cell.Value                                ' Name new Blad
        ws.Range("F4").Value = cell.Value                   ' Copy from Blad1 column C to new Blad F4
        ws.Range("B1").Value = cell.Offset(, 1).Value       ' Copy from Blad1 column D to new Blad B1
        'ws.Range("F40").Value = cell.Offset(, 2).Value     ' ???
    Next cell

End Sub
 
Upvote 0
AlphaFrog said:
I think you only have to change just the one Sheet1 (red) to Blad1. All the rest of the code is the same but I really don't know for sure.

Code: 
Sub bynamn2()

    Dim cell As Range, ws As Worksheet
    
    For Each cell In [COLOR=Red]Sheet1[/COLOR].Range("C7:C13")                 ' Loop for each cell in Blad1 C7:C13
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))    ' Add new Blad
        ws.Name = cell.Value                                ' Name new Blad
        ws.Range("F4").Value = cell.Value                   ' Copy from Blad1 column C to new Blad F4
        ws.Range("B1").Value = cell.Offset(, 1).Value       ' Copy from Blad1 column D to new Blad B1
        'ws.Range("F40").Value = cell.Offset(, 2).Value     ' ???
    Next cell

End Sub
Click to expand...

it works great. I did a really stupid thing I forgot to add Option Explicit

and I had already created sheet2.



is it possible to copy blad2 dependent on values in range c7 to c13 in blad1?

Rich (BB code): 
this is what i tried
 Set ws = Sheets("Blad2").Add(After:=Sheets(Sheets.Count)) 
Set ws = Blad2.Add(After:=Sheets(Sheets.Count))

F40 in newly created sheets i would like to put in the blad1 at range E7,E8,E9 and so on. is it possible ?

my last question do you recommend any tutorial/books ?
i wish to contribute to this forum as well as become better at excel.
And thank you so much :)
 
Upvote 0
milking said:
is it possible to copy blad2 dependent on values in range c7 to c13 in blad1?

F40 in newly created sheets i would like to put in the blad1 at range E7,E8,E9 and so on
Click to expand...

Code: 
    For Each cell In Blad1.Range("C7:C13")                  ' Loop for each cell in Blad1 C7:C13
        [COLOR="Red"]Blad2.Copy[/COLOR] After:=Sheets(Sheets.Count)    ' copy Blad2
        Set ws = ActiveSheet
        ws.Name = cell.Value                                ' Name new Blad
        ws.Range("F4").Value = cell.Value                   ' Copy from Blad1 column c to new Blad F4
        ws.Range("B1").Value = cell.Offset(, 1).Value       ' Copy from Blad1 column D to new Blad B1
        [COLOR="Red"]cell.Offset(, 2).Value = ws.Range("F40").Value[/COLOR]      ' copy from new Blad F40 to Blad1 column E
    Next cell

milking said:
do you recommend any tutorial/books ?
i wish to contribute to this forum as well as become better at excel.
Click to expand...
I don't have a recommendation.

TIP: You can get get example code by using the macro recorder. E.g. you could have recorded a macro where you copied Blad2. That would have shown you the syntax Sheets("Blad2").Copy After:=Sheets(4)
 
Last edited:
Upvote 0
AlphaFrog you rule :) thx so much your code works great. But the code buggs out if there isn't any values in range C6-C24 for example if i stop at C11.

So i fixed it using this, but this isn't a good fix.
Code: 
Sub skapawbs()
Dim cell As Range, ws As Worksheet
On Error GoTo Termininate
 
    For Each cell In Blad1.Range("C6:C24")
        Sheets("0").Visible = True
       If IsEmpty(cell) Then GoTo Termininate
        Blad2.Copy After:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        ws.Name = cell.Value
        ws.Range("F4").Value = cell.Value
        ws.Range("B1").Value = cell.Offset(, 1).Value
        cell.Offset(, 2).Value = ws.Range("F40").Value
    Next cell
 
Termininate:
MsgBox "done"
End Sub

i have tried this
Code: 
Sub Makro3()
Dim ws As Worksheet
Range("C6").Select
Do Until ActiveCell.Offset(, 1) = ""  
  Blad2.Copy After:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        ws.Name = ActiveCell.Value 'this were i get a error.
        ws.Range("F4").Value = ActiveCell.Value
        ws.Range("B1").Value = ActiveCell.Offset(, 1).Value
Loop
End Sub
 
Upvote 0
Code: 
Sub skapawbs()
Dim cell As Range, ws As Worksheet
 
    For Each cell In Blad1.Range("C6:C24")
        [COLOR="Red"]If cell.Value = "" Then Exit For[/COLOR]
        Sheets("0").Visible = True
        Blad2.Copy After:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        ws.Name = cell.Value
        ws.Range("F4").Value = cell.Value
        ws.Range("B1").Value = cell.Offset(, 1).Value
        cell.Offset(, 2).Value = ws.Range("F40").Value
    Next cell
MsgBox "done"
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
index match excel formula to vba code
Replies
9
Views
356
DanteAmor
DanteAmor
S
  • Question Question
Create New Sheet with Specific Name Based on Variable Cell
Replies
0
Views
237
SBExcel123
S
P
  • Question Question
Populating, aggregating and sorting multiple matching values in Excel
Replies
0
Views
209
Pbobas
P
M
  • Question Question
Execute Macro from an open file instead of specific file name
Replies
0
Views
461
Monabil
M
D
  • Question Question
String running first time but when looping back it isnt placing correctly.
Replies
1
Views
509
DanSMT
D

Forum statistics

Threads
1,224,530
Messages
6,179,373
Members
452,907
Latest member
Roland Deschain

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top