---

Jeg har et ark som jeg kalder for "hovedark"
Derudover har jeg ca. 10 ark som bliver kaldt ark1 til ark 10

I hovedarket er en kolonne en værdi fra 1 til 10 - den linje som
er 1 skal kopieres til ark1 og linje som er 2 skal til ark 2 osv.

Kan dette gøres automatisk og hvis ja kan nogen give mig et hint til hvordan
jeg kommer videre.

Det er Excel 2002 DK.


Mvh. Allan

---

Hej Allan.

Prøv nedenstående hint.


Option Explicit
Const hil As String = "Best regards from Joergen"

Const MainsheetName As String = "Hovedark"
Const Startcell As String = "C3"


'----------------------------------------------------------
' Procedure : FromMainsheet
' Date : 20051217
' Author : Joergen Bondesen
' Purpose : Copy Table row from Table in
' 'Const MainsheetName' to "Ark" & X
' X is digits in 1 coloum in Table
' Note : "Ark" = Sheetname
'----------------------------------------------------------
'
Sub FromMainsheet()

Dim RMaintable As Range
Dim TotNoOfSheets As Long
Dim TotNoTableRows As Long
Dim cell As Range
Dim countshno As Long
Dim rowno As Long
Dim x As Long
Dim newrange As String


Set RMaintable = Worksheets(MainsheetName) _
.Range(Startcell).CurrentRegion

TotNoOfSheets = ActiveWorkbook.Worksheets.Count

TotNoTableRows = RMaintable.Rows.Count

'// Sheets controle
If (TotNoOfSheets - 1) < TotNoTableRows Then
MsgBox "Your table have rows: " & TotNoTableRows _
& vbCr & vbCr & "and you have max worksheets: " _
& (TotNoOfSheets - 1), vbCritical, hil
End
End If

For x = 1 To (TotNoTableRows + 1)
If x = 1 Then
If UCase(Worksheets(1).Name) <> _
UCase(MainsheetName) Then

MsgBox "Your 1 sheetname is not: " _
& MainsheetName, vbCritical, hil
End
End If
Else

If UCase(Worksheets(x).Name) <> _
UCase("Ark" & (x - 1)) Then

MsgBox "SheetName: " & Worksheets(x).Name _
& " must be: " & "Ark" & (x - 1), _
vbCritical, hil
End
End If

End If
Next x

'// Table copy
For Each cell In RMaintable.Resize(TotNoTableRows, 1)

rowno = Sheets("Ark" & cell.Value) _
.Range("A" & Rows.Count).End(xlUp).Row

newrange = cell.Resize(1, RMaintable.Columns.Count) _
.Address

Worksheets(MainsheetName).Range(newrange).Copy _
Destination:=Worksheets("Ark" & cell.Value) _
.Range("A" & (rowno + 1))

Next cell

End Sub


--
Med venlig hilsen
Jørgen Bondesen


"Allan Møller" <allanatallanmdotdk> wrote in message
news:43a35380$0$15794$14726298@news.sunsite.dk...
> Jeg har et ark som jeg kalder for "hovedark"
> Derudover har jeg ca. 10 ark som bliver kaldt ark1 til ark 10
>
> I hovedarket er en kolonne en værdi fra 1 til 10 - den linje som
> er 1 skal kopieres til ark1 og linje som er 2 skal til ark 2 osv.
>
> Kan dette gøres automatisk og hvis ja kan nogen give mig et hint til
> hvordan
> jeg kommer videre.
>
> Det er Excel 2002 DK.
>
>
> Mvh. Allan

---

> Hej Allan.
>
> Prøv nedenstående hint.

Hej Jørgen.

Det vil jeg meget gerne gøre men jeg aner simpelthen ikke hvad det
er som du har lavet der.
Er det noget VB og hvad skal jeg gøre med det ?

Beklager men jeg er meget ny i Excel.


Mvh. Allan

---

Hej Allan

> Beklager men jeg er meget ny i Excel.

Vi tager udgangspunkt i, at du er ny.

VBA delen er på engelsk, uanset sprog.

Når vi taler VBA, er der for os "dødelige" 3 steder.


1. Sheet
2. ThisWorkbook
3. Module


ad1. Ved højreklik på fanebladet, vælges vis koder.
Her kan placeres/vælges en såkaldt event (hændelse)
Øverst har du 2 små felter. Tv. kan du vælge sheet
og th. kan du vælge Event.

E.g.
Når celle B2 markeres vil der komme en msgbox der viser "Hej"

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$B$2" Then MsgBox "Hej"
End Sub



ad2.
Nu skal vi ind i VBA delen: [Alt + F11] - [ctrl + R]
Tv. har du VBA project og th. har du koden
(forudst der er en).
Først finder man filen og herefter markeres
Sheet/ThisWorkbook/Module. Dobbeltklik eller Enter.
I Thisworkbook har du også Event, principielt som ad1, men
relateret til hele filen.

Her kan man f.eks aktivere et module (makro) som skal kører
når du åbner/lukker filen.


E.g
Option Explicit

Private Sub Workbook_Open()
MsgBox "We have just opened: " & ActiveWorkbook.Name
End Sub


ad3.
Nu skal vi ind i VBA delen: [Alt + F11] [ctrl + R]
Tv. har du VBA project og th. har du koden
(forudst der er en).
Først finder man filen og herefter Menu: Insert - Module
hvorefter markøren står i Modulet.
Der kan være flere Moduler i en fil.

Den ny (nedenstående) kode kopieres nu ind i Modulet.

Aktivering af makroen.
Du kan placere markøren inde imellem Sub og med F8 kører
trinvis eller F5 kører igennem.
Vær opmærksom på, at min makro ikke er afhængi af at et
bestemt ark skal være markeret.
Det vil en nybegynder som regel, så pas på, når der køres
fra Module, evt. start makro med at vælge sheet.
Med F9 kan du indsætte "stop". Prøv dig frem.

Min makro er "meget avanceret" for en nybegynder, så
du kan have svært ved at tolke den. Men det kommer.


Med [Alt + Q] kommer du ud i regnearket.
[Alt + F8] - vælg makro - kør.


Et par eks.
E.g.
'ThisWorkbook
Option Explicit

Private Sub Workbook_Open()
hejsa
End Sub

'Module
Option Explicit

Sub hejsa()
MsgBox "welcome", vbInformation
End Sub


' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


E.g.
'ThisWorkbook
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
beback
End Sub

'Module
Option Explicit

Sub beback()
MsgBox "Thanks for today", vbInformation
End Sub


' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


Brug den indbyggede hjælp
E.g. RMaintable.Resize(TotNoTableRows, 1)
Lad markøren blinke mellem e og s i Resize og tast F1.


' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


Den aktuelle makro:

'Hvis navnet på "Hovedark" ændres, skal du også ændre her.
Const MainsheetName As String = "Hovedark"

'Dette er startcellen for din tabel
Const Startcell As String = "C3"

Bemærk at en Tabel ALTID skal have en tom række for oven
og en for neden samt en tom kolonne på begge sider.

Hvis der skal uddybning til, vender du tilbage.

God fornøjelse.


' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

'Jeg har fundet en fejl i min makro, så her er en opdateret.


Option Explicit
Const hil As String = "Best regards from Joergen"

Const MainsheetName As String = "Hovedark"
Const Startcell As String = "C3"


'----------------------------------------------------------
' Procedure : FromMainsheet
' Date : 20051217, rev. 01
' Author : Joergen Bondesen
' Purpose : Copy Table row from Table in
' 'Const MainsheetName' to "Ark" & X
' X is digits in 1 coloum in Table
' Note : "Ark" = Sheetname
' A Table MUST be surrounded by empty cells
'----------------------------------------------------------
'
Sub FromMainsheet()

Dim RMaintable As Range
Dim TotNoOfSheets As Long
Dim TotNoTableRows As Long
Dim cell As Range
Dim countshno As Long
Dim rowno As Long
Dim x As Long
Dim newrange As String

On Error Resume Next
Set RMaintable = Worksheets(MainsheetName) _
.Range(Startcell).CurrentRegion
If Err <> 0 Then
MsgBox "1 sheetname is not: " _
& MainsheetName, vbCritical, hil
End
End If

TotNoOfSheets = ActiveWorkbook.Worksheets.Count

TotNoTableRows = RMaintable.Rows.Count

'// Sheets controle
If (TotNoOfSheets - 1) < TotNoTableRows Then
MsgBox "Your table have rows: " & TotNoTableRows _
& vbCr & vbCr & "and you have max worksheets: " _
& (TotNoOfSheets - 1), vbCritical, hil
End
End If

For x = 1 To (TotNoTableRows + 1)
If x = 1 Then
If UCase(Worksheets(1).Name) <> _
UCase(MainsheetName) Then

MsgBox "Your 1 sheetname is not: " _
& MainsheetName, vbCritical, hil
End
End If
Else

If UCase(Worksheets(x).Name) <> _
UCase("Ark" & (x - 1)) Then

MsgBox "SheetName: " & Worksheets(x).Name _
& " must be: " & "Ark" & (x - 1), _
vbCritical, hil
End
End If

End If
Next x

'// Table copy
For Each cell In RMaintable.Resize(TotNoTableRows, 1)

rowno = Sheets("Ark" & cell.Value) _
.Range("A" & Rows.Count).End(xlUp).Row

newrange = cell.Resize(1, RMaintable.Columns.Count) _
.Address

Worksheets(MainsheetName).Range(newrange).Copy _
Destination:=Worksheets("Ark" & cell.Value) _
.Range("A" & (rowno + 1))

Next cell

Set RMaintable = Nothing
End Sub


--
Med venlig hilsen
Jørgen Bondesen

---

> Hej Allan
>
>> Beklager men jeg er meget ny i Excel.
>
> Vi tager udgangspunkt i, at du er ny.
Og det er jeg

Det var godt en gang avanceret omgang for at lave det men inden jeg giver
mig i kast
med den noget store opgave vil jeg gerne være sikker på at det kommer til at
ende med det resultat jeg gerne ville have.

Jeg har et excelark som er "hovedark" på dette ark står alt kørsel til en
dag
og er delt ca. sådan her op :
| linjenr | Udkl. |Vognnr | Hjemadresse | Udadresse | Hjemkl. |Vognnr |
linjenr |


Det jeg så vil have det til er at der hvor f.eks. vogn 1 skal køre kunden
frem
skal kopieres til et ark som hedder vogn1 - altså hele linje med alle info.

Der kan være mange kørsler til vogn 1 og det skulle gerne kunne lave det
sammen for vogn 1 til 25.

Det skulle så gerne ende med at alle de kunder som er sat til at køre med en
vogn
bliver delt ud på de vogne som de skal køre med - både ud og retur.

Jeg har som lavet arket som jeg havde en ide om det skulle ende med at se ud
ved ikke om det har nogen interesse at se det men det kan hentes her :
http://www.allanm.dk/test1.zip


Men det jeg vil frem til : Kan excel klare denne opgave med det som du har
skrevet ?
Om det så er en makro eller VB det ved jeg ikke rigtigt



Mvh. Allan Møller

---

Hej Allan

Jeg tror vi skal gennem en del ping/pong, så jeg vil foreslå, at du sender
mig en mail, så vi kan maile frem og tilbage.

Den endelige version vil blive lagt på dk.binaer.

OK?

--
Med venlig hilsen
Jørgen Bondesen


"Allan Møller" <allanatallanmdotdk> wrote in message
news:43a426e9$0$15786$14726298@news.sunsite.dk...
>> Hej Allan
>>
>>> Beklager men jeg er meget ny i Excel.
>>
>> Vi tager udgangspunkt i, at du er ny.
> Og det er jeg
>
> Det var godt en gang avanceret omgang for at lave det men inden jeg giver
> mig i kast
> med den noget store opgave vil jeg gerne være sikker på at det kommer til
> at
> ende med det resultat jeg gerne ville have.
>
> Jeg har et excelark som er "hovedark" på dette ark står alt kørsel til en
> dag
> og er delt ca. sådan her op :
> | linjenr | Udkl. |Vognnr | Hjemadresse | Udadresse | Hjemkl. |Vognnr |
> linjenr |
>
>
> Det jeg så vil have det til er at der hvor f.eks. vogn 1 skal køre kunden
> frem
> skal kopieres til et ark som hedder vogn1 - altså hele linje med alle
> info.
>
> Der kan være mange kørsler til vogn 1 og det skulle gerne kunne lave det
> sammen for vogn 1 til 25.
>
> Det skulle så gerne ende med at alle de kunder som er sat til at køre med
> en vogn
> bliver delt ud på de vogne som de skal køre med - både ud og retur.
>
> Jeg har som lavet arket som jeg havde en ide om det skulle ende med at se
> ud
> ved ikke om det har nogen interesse at se det men det kan hentes her :
> http://www.allanm.dk/test1.zip
>
>
> Men det jeg vil frem til : Kan excel klare denne opgave med det som du har
> skrevet ?
> Om det så er en makro eller VB det ved jeg ikke rigtigt
> Mvh. Allan Møller