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 CopyData() Dim FraArk As Worksheet Set FraArk = Sheets("Ark1") Dim TilArk As Worksheet Set TilArk = Sheets("Ark2")
i = 1 Do Until Len(FraArk.Cells(i, 1).Text) = 0 If FraArk.Cells(i, 1).Value = 1 Then o = 1 Do Until Len(TilArk.Cells(o, 1).Text) = 0 o = o + 1 Loop TilArk.Cells(o, 1) = FraArk.Cells(i, 2).Value End If i = i + 1 Loop End Sub
Er ikke helt sikker på jeg har forstået det rigtigt.
Altså hvis der står 1 i A1 eller A2 eller A3 - så skal B2-B4 kopieres?
Sub CopyDataNy() Dim FraArk As Worksheet Dim TilArk As Worksheet Set FraArk = Sheets("Ark1") Set TilArk = Sheets("Ark2")
If FraArk.Range("A1").Value = 1 Or FraArk.Range("A2").Value = 1 Or FraArk.Range("A3").Value = 1 Then o = 1 Do Until Len(TilArk.Cells(o, 1).Text) = 0 o = o + 1 Loop TilArk.Cells(o, 1) = FraArk.Range("B2").Value TilArk.Cells(o + 1, 1) = FraArk.Range("B3").Value TilArk.Cells(o + 2, 1) = FraArk.Range("B4").Value End If End Sub
Kan jeg få lidt mere hjælp.... Kunne godt tænke mig at hvis der stod 1 i D1, så overførte den indholdet af A1 til ark2´s A1, 1 i D2 overførte A2 til ark2´s A2 osv. osv.
Men jeg kan kun få den til at tjekke én celle med din kode som jeg har tilrettet lidt:
Sub CopyDataNy() Dim FraArk As Worksheet Dim TilArk As Worksheet Set FraArk = Sheets("Ark1") Set TilArk = Sheets("Ark2")
If FraArk.Range("D1:D300").Value = 1 Then o = 1 Do Until Len(TilArk.Cells(o, 1).Text) = 0 o = o + 1 Loop TilArk.Range("A1:B300") = FraArk.Range("A1:A300").Value TilArk.Range("B1:B300") = FraArk.Range("B1:B300").Value
Hvis jeg forstår det rigtigt så er det lidt ligesom den første kode gjorde? :)
Denne her tager fra A1 til A(Række) ikke har en værdi. Hvis der står 1 i D(Række) så kopiere den A(Række) til A(Række) på Ark2
Sub CopyData() Dim FraArk As Worksheet Dim TilArk As Worksheet Set FraArk = Sheets("Ark1") Set TilArk = Sheets("Ark2")
i = 1 Do Until Len(FraArk.Cells(i, 1).Text) = 0 If FraArk.Cells(i, 4).Value = 1 Then TilArk.Cells(i, 1) = FraArk.Cells(i, 1).Value End If i = i + 1 Loop 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.