Jeg har behov for en kode der kopierer en værdi fra celle A1 i Projekt Ark1, åbner Projekt Ark2 og indsætter værdi ud for dags dato som er listet i kolonne A. Alle dato står i kolenne A og værdien skal indsættes ud for dags dato i kolonne B, C, D osv.
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
Sub xWrite() Application.ScreenUpdating = False xValue = Range("A1") 'Ret sti og filnavn.type til aktuel Workbooks.Open Filename:="C:\Users\Poul\Desktop\My_Test.xlsx" 'Ret arknavn og evt. range til aktuel Sheets("Ark1").Range("A1:A1000").Find(Date, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Select Selection.Resize(1, 3) = xValue ActiveWorkbook.Close True Application.ScreenUpdating = True End Sub
Det virker fint, dog skal værdien ikke sættes ind 3 steder (B,C,D) men kun et sted i en celle der er fri. Står der en allerede en værdi ud for dato 15-03-2018 i celle B, skal værdien sættes ind i celle C, altså fortløbende i en celle der er fri.
Sub xWrite() Application.ScreenUpdating = False xValue = Range("A1") 'Ret sti og filnavn.type til aktuel Workbooks.Open Filename:="C:\Users\Poul\Desktop\My_Test.xlsx" 'Ret arknavn og evt. range til aktuel Sheets("Ark1").Range("A1:A1000").Find(Date, LookIn:=xlValues, LookAt:=xlWhole).Select Selection.Offset(0, Cells(Selection.Row, 16000).End(xlToLeft).Column) = xValue 'Selection.Resize(1, 3) = xValue ActiveWorkbook.Close True Application.ScreenUpdating = True End Sub
Tak. Koden fejler ikke, filen (projektet) bliver åbnet og gemt, men der er ikke nogle værdier i feltet ud for dato. Med andre ord den gemmer ikke værdierne.
Er alle celler tomme i samme række til højre for hvor værdi skal indsættes.? hvis der fx er et enkelt mellemrum eller anden værdi i en celle ude til højre, vil værdien blive indsat til højre for denne celle.
Koden virker fint i min test har rettet i denne linie.: Selection.Offset(0, Cells(Selection.Row, Columns.Count).End(xlToLeft).Column) = xValue
Sub xWrite() Application.ScreenUpdating = False xValue = Range("A1") 'Ret sti og filnavn.type til aktuel Workbooks.Open Filename:="C:\Users\Poul\Desktop\My_Test.xlsx" 'Ret arknavn og evt. range til aktuel Sheets("Ark1").Range("A1:A1000").Find(Date, LookIn:=xlValues, LookAt:=xlWhole).Select Selection.Offset(0, Cells(Selection.Row, Columns.Count).End(xlToLeft).Column) = xValue ActiveWorkbook.Close True Application.ScreenUpdating = True End Sub
Synes godt om
Ny brugerNybegynder
Din løsning...
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.