14. december 2018 - 20:30Der er
20 kommentarer og 1 løsning
Hjælp til VBA: Send data fra et ark til et andet.
Hej.
Jeg har en forside som ser sådan ud:
(A1)Medarbejder:
(A2)Timer:
(A3)Måned:
Jeg har dertil 12 forskellige ark; jan. - dec. Nu vil jeg gerne lave en kode, der sender mine data ind på den rigtige celle i det rigtige ark.
Cellerne dataene skal sendes til hedder:
(Medarbejder):B2
(Timer):B5
Alle data skal ende i de samme celler uanset hvilket ark de skal sendes til, altså B2 og B5.
Jeg vil gerne gøre det sådan, at når jeg klikker på min VBA knap, så sender excel automatisk datoen ind på de rigtige celler i det ark der er defineret på forsiden som måned.
Nogen der kan hjælpe mig med at skrive denne kode?
Såfremt dine ark hedder Januar, Februar og så videre, kan denne kode klare det., Du kan knytte den til en knap eller bare afspille den ved at definere en genvej.
Sub Overfoer() Dim Navn As String, Tid As Variant, Ark As String Navn = Sheets(1).Range("A1") Tid = Sheets(1).Range("A2") Ark = Sheets(1).Range("A3") Sheets(Ark).Activate ActiveSheet.Range("b2").Value = Navn ActiveSheet.Range("b5").Value = Tid Sheets(1).Activate End Sub
Hvis du vil sikre dig at der ikke sker fejl, kan du udbygge med fejlkode, som her
Sub Overfoer()
Dim Navn As String, Tid As Variant, Ark As String
On Error GoTo Fejl:
Navn = Sheets(1).Range("A1") Tid = Sheets(1).Range("A2") Ark = Sheets(1).Range("A3")
Sheets(Ark).Activate ActiveSheet.Range("b2").Value = Navn ActiveSheet.Range("b5").Value = Tid Sheets(1).Activate
Fejl: If Err.Number = 9 Then MsgBox "Det ark, du vil sende data til eksisterer ikke" & vbCrLf & _ "Kontroller måneden i A3, ret og prøv igen.", vbCritical Exit Sub End If
End Sub
Den tjekker at månedsnavnet i A3 faktisk svarer til et arknavn. Der bør måske også udbygges med, at kontrollere om navn og/eller tid faktisk er udfyldt, men det må bleive en anden gang.
Jeg oplever i øvrigt også, at nå jeg prøver at afspille makroen, så fryser mit ark og jeg kan ikke skrive i mine andre tomme celler, eller skifte mellem mine ark?
Sub Overfoer() Dim Timer As String, Udgift As String, Beløb As Variant, Ark As String Timer = Sheets(1).Range("D5") Udgift = Sheets(1).Range("D9") Beløb = Sheets(1).Range("D10") Ark = Sheets(1).Range("G5") Sheets(Ark).Activate ActiveSheet.Range("b5").Value = Timer ActiveSheet.Range("a35").Value = Udgift ActiveSheet.Range("b35").Value = Beløb Sheets(1).Activate End Sub
Fandt ud af, at jeg var nødt til ændre nogle af kriterierne for at det gav mere mening i sidste ende.
Men, jeg kunne godt tænke mig, at hver gang jeg har afspillet mig makro, at den sletter indholdet i kriteriefelterne - ?
Jeg ville også gerne have at felterne udgift og beløb, for hvergang jeg afspiller mikroen, indsættes i første ledige celle nedadgående, med udgangspunkt i de celler der står nu (a35 og b35) - kan man det?
Og tusinde mange tak for hjælpen indtil videre! Var aldrig kommet så langt på egen hånd :)
Ja til begge, men harc desværre ikke tid til art hjælpe før efter jul, da jeg er på vej på ferie. At slette kriterierne er dog let nok. Efter Sheets(1).Activate kan du indsætte
Fandt en ledig stund midt i pakningen.- dette skulle løse alt det, du har omtalt, men kræver at der står nogen, fx overskrifter el.l. i A34 og B34 i alle månedsarkene.
Sub Overfoe2() Dim Timer As String, Udgift As String, Beløb As Variant, Ark As String Timer = Sheets(1).Range("D5") Udgift = Sheets(1).Range("D9") Beløb = Sheets(1).Range("D10") Ark = Sheets(1).Range("G5") Sheets(Ark).Activate ActiveSheet.Range("b5").Value = Timer Range("A1000000").End(xlUp).Offset(1, 0).Value = Udgift Range("B1000000").End(xlUp).Offset(1, 0).Value = Beløb Sheets(1).Activate Range("D5,D9:D10,G5").ClearContents End Sub
Jeg har lidt problemer med det.. den sender mine data ind under de sidste celler i hver deres respektive kolonne hvor i der står noget - selv om der er står noget i både A34 og B34.
Den sender i dette tilfælde dataene ind på A49 og B44 - de sidste celler der står under de sidste celler i hver af deres kolonner med indhold i.
Har prøvet at skrive det om selv, men kan ikke rigtigt få det til at virke desværre.
Jeg fik fikset mit ovenstående problem, så nu spiller det bare :) mange tak for hjælpen.
Jeg har dog prøvet at skrive lidt yderligere kode selv. På min forside har jeg opstillet en boks, så jeg kan indskrive om en udgift er betalt og hvilken dato den er betalt. Min kode ser sådan her ud:
Sub Indskriv() Dim Leje As String, Forplejning As String, Forsikring As String, Afbetaling As String, UK As String, FDK As String, Musik As String, TV As String, Sygeforsikring As String, Variabel1 As String, Variabel2 As String, Variabel3 As String, Variabel4 As String, Variabel5 As String, Variabel6 As String, Variabel7 As String, Dato1 As String, Dato2 As String, Dato3 As String, Dato4 As String, Dato5 As String, Dato6 As String, Dato7 As String, Dato8 As String, Dato9 As String, Dato10 As String, Dato11 As String, Dato12 As String, Dato13 As String, Dato14 As String, Dato15 As String, Dato16 As String, Ark As String Leje = Sheets(1).Range("K4") Forplejning = Sheets(1).Range("K5") Forsikring = Sheets(1).Range("K6") Afbetaling = Sheets(1).Range("K7") UK = Sheets(1).Range("K8") FDK = Sheets(1).Range("K9") Musik = Sheets(1).Range("K10") TV = Sheets(1).Range("K11") Sygeforsikring = Sheets(1).Range("K12") Ark = Sheets(1).Range("M3") Variabel1 = Sheets(1).Range("K14") Variabel2 = Sheets(1).Range("K15") Variabel3 = Sheets(1).Range("K16") Variabel4 = Sheets(1).Range("K17") Variabel5 = Sheets(1).Range("K18") Variabel6 = Sheets(1).Range("K19") Variabel7 = Sheets(1).Range("K20") Dato1 = Sheets(1).Range("L4") Dato2 = Sheets(1).Range("L5") Dato3 = Sheets(1).Range("L6") Dato4 = Sheets(1).Range("L7") Dato5 = Sheets(1).Range("L8") Dato6 = Sheets(1).Range("L9") Dato7 = Sheets(1).Range("L10") Dato8 = Sheets(1).Range("L11") Dato9 = Sheets(1).Range("L12") Dato10 = Sheets(1).Range("L14") Dato11 = Sheets(1).Range("L15") Dato12 = Sheets(1).Range("L16") Dato13 = Sheets(1).Range("L17") Dato14 = Sheets(1).Range("L18") Dato15 = Sheets(1).Range("L19") Dato16 = Sheets(1).Range("L20") Sheets(Ark).Activate ActiveSheet.Range("e22").Value = Leje ActiveSheet.Range("e23").Value = Forplejning ActiveSheet.Range("e24").Value = Forsikring ActiveSheet.Range("e25").Value = Afbetaling ActiveSheet.Range("e26").Value = UK ActiveSheet.Range("e27").Value = FDK ActiveSheet.Range("e28").Value = Musik ActiveSheet.Range("e29").Value = TV ActiveSheet.Range("e30").Value = Sygeforsikring ActiveSheet.Range("e35").Value = Variabel1 ActiveSheet.Range("e36").Value = Variabel2 ActiveSheet.Range("e37").Value = Variabel3 ActiveSheet.Range("e38").Value = Variabel4 ActiveSheet.Range("e39").Value = Variabel5 ActiveSheet.Range("e40").Value = Variabel6 ActiveSheet.Range("e41").Value = Variabel7 ActiveSheet.Range("f22").Value = Dato1 ActiveSheet.Range("f23").Value = Dato2 ActiveSheet.Range("f24").Value = Dato3 ActiveSheet.Range("f25").Value = Dato4 ActiveSheet.Range("f26").Value = Dato5 ActiveSheet.Range("f27").Value = Dato6 ActiveSheet.Range("f28").Value = Dato7 ActiveSheet.Range("f29").Value = Dato8 ActiveSheet.Range("f30").Value = Dato9 ActiveSheet.Range("f35").Value = Dato10 ActiveSheet.Range("f36").Value = Dato11 ActiveSheet.Range("f37").Value = Dato12 ActiveSheet.Range("f38").Value = Dato13 ActiveSheet.Range("f39").Value = Dato14 ActiveSheet.Range("f40").Value = Dato15 ActiveSheet.Range("f41").Value = Dato16 Sheets(1).Activate Range("K4,K12:L4,L12:K14,K21:L14,L21").ClearContents End Sub
Når jeg prøver at afspille den, så får jeg beskeden: "Der opstod en kompileringsfejl:
Ikke tilladt uden for en procedure"
Jeg kan ikke selv lige spotte hvor fejlen ligger - ? :O
Koden står i samme modul, som den første kode jeg fik hjælp til.
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
