Kopiere en celle fra et ar ktil et andet via Makro

Det ser ud til at du har læst det ind i en variabel, så kan du ikke få formlen med, så skal du kopiere direkte. fra cellen.

men prøv lige at sætte den del af koden ind, hvor du indlæser i variablen, og fortæl også i hvilken kolonne din formel ligger.

du kan godt få formler med, men over i en variabel, det gøres sådan.
eks.
DATA = Range("a1").CurrentRegion.Formula

eller
poster(K, 0) = Data(J, 1).formula

Jeg har prøvet exelents forsøg, men det virkede ikke.
Kabbaks forslag kan jeg ikke lige finde ud af at implementere :-). Er ikke stærk nok i vba.

Den kode jeg har henter data fra ark1 hvis der ENTEN er tal i kolonne c ELLER kol D ELLER begge kolonner.

Hvis der er data i en af de celler skal den hente hele linien over. Det vil sige KOL A-O (helst med formler)

Den kode jeg sætter ind nu har jeg brugt til noget lignende (dog uden formler)og håbede på at jeg kunne genbruge koden.

I ark1 er der ca. 4000 linier med lopslag i flere kolonner på hver linie.
Der er dog kun ca. 50 af linierne der har tal i (forskellige fra gang til gang)

Derfor vil jeg gerne have en kode der henter de linier der ENTEN har tal i kolonne  kol c ELLER kol D ELLER i begge kolonner.

Jeg sætter lige den kode ind jeg har brugt, men efter hvad I lige har skrevet tror jeg ikke at den kan bruges, eller hvad siger I?

Ark1=konto 
Ark2=oversigt1




Sub opdaterkoder()



Application.ScreenUpdating = False

With Worksheets("konto")



Start = 1

Slut = .Range("A65536").End(xlUp).Row



For I = 2 To Worksheets("oversigt1").Range("C65536").End(xlUp).Row

    If Not IsEmpty(Cells(I, 1).Value) Then

        For J = Start To Slut

            If Cells(I, 1).Value = .Cells(J, 1).Value Then

                If Cells(I, 9).Value <> .Cells(J, 7).Value Then

                    .Cells(J, 7) = Cells(I, 9)

                End If

                Start = J

                Exit For

            End If

        Next J

    End If

Next I



End With


' herefter hentes de opdaterede overskrifter ind i arket igen






Dim poster()



With Worksheets("konto")

    Data = .Range("A5:I" & .Range("B7000").End(xlUp).Row + 1)

End With



With Worksheets("oversigt1")

    On Error Resume Next

    .Range("A5:G" & .Range("A65536").End(xlUp)).ClearContents

    Rows.RowHeight = 12.75

    Cells.PageBreak = xlPageBreakNone

End With



ReDim poster(UBound(Data), 10)



poster(K, 1) = "Drift"

K = K + 1



For J = 1 To UBound(Data)

   

    If Data(J, 2) = UCase("BALANCE IALT") Then

        poster(K, 1) = "I alt"

        poster(K, 4) = Totaliår

        poster(K, 6) = Totalsidsteår

        K = K + 2

        poster(K, 1) = "Afstemning"

        poster(K, 4) = AfstemningÅr1 + Totaliår

        poster(K, 6) = AfstemningÅr2 + Totalsidsteår

        Exit For

    End If

   

    If Data(J, 2) = UCase("AKTIVER:") Then

        poster(K, 1) = "I alt"

        poster(K, 4) = Totaliår

        poster(K, 6) = Totalsidsteår

        K = K + 2

        poster(K, 1) = "Aktiver"

        K = K + 1

        AfstemningÅr1 = AfstemningÅr1 + Totaliår

        AfstemningÅr2 = AfstemningÅr2 + Totalsidsteår

        Totaliår = 0: Totalsidsteår = 0

    End If

   

    If Data(J, 2) = UCase("GÆLD OG EGENKAPITAL:") Then

        poster(K, 1) = "I alt"

        poster(K, 4) = Totaliår

        poster(K, 6) = Totalsidsteår

        K = K + 2

        poster(K, 1) = "Passiver"

        K = K + 1

        AfstemningÅr1 = AfstemningÅr1 + Totaliår

        AfstemningÅr2 = AfstemningÅr2 + Totalsidsteår

        Totaliår = 0: Totalsidsteår = 0

    End If

   

    If IsNumeric(Data(J, 3)) Or IsNumeric(Data(J, 5)) Then

        If Data(J, 3) <> 0 Or Data(J, 5) <> 0 Then

            If Data(J, 7) <> poster(K - 1, 8) And poster(K - 1, 2) <> "" Then

                K = K + 1

            End If

            poster(K, 0) = Data(J, 1)

            poster(K, 2) = Data(J, 2)

            poster(K, 4) = Data(J, 3)

            poster(K, 6) = Data(J, 5)

            poster(K, 8) = Data(J, 7)

            poster(K, 10) = Data(J, 8)

            K = K + 1

            Totaliår = Totaliår + Data(J, 3)

            Totalsidsteår = Totalsidsteår + Data(J, 5)

        End If

    End If

Next J



Worksheets("oversigt1").Range("A5").Resize(UBound(poster), 11) = poster



For I = 2 To Worksheets("oversigt1").Range("A65536").End(xlUp).Row

If Cells(I, 1) = "" And Cells(I - 1, 1) <> "" And Cells(I + 1, 1) <> "" Then

    Rows(I).RowHeight = 7

End If

Next I



Application.ScreenUpdating = False

With Worksheets("konto")



Start = 1

Slut = .Range("A65536").End(xlUp).Row



For I = 2 To Worksheets("oversigt1").Range("C65536").End(xlUp).Row

    If Not IsEmpty(Cells(I, 1).Value) Then

        For J = Start To Slut

            If Cells(I, 1).Value = .Cells(J, 1).Value Then

                If Cells(I, 9).Value <> .Cells(J, 7).Value Then

                    .Cells(J, 7) = Cells(I, 9)

                End If

                Start = J

                Exit For

            End If

        Next J

    End If

Next I


End With

End Sub

Nu hvor sværhedsgraden er ændret, runder jeg gerne op med point for svaret. :-)

prøv at rette
  Data = .Range("A5:I" & .Range("B7000").End(xlUp).Row + 1)

til
  Data = .Range("A5:I" & .Range("B7000").End(xlUp).Row + 1).formula

det er uden garanti ;-))

Det betyder at alt indlæses som formler, og alle værdier som tekst, så der hvor formlerne viser en værdi, er det kun formlen der kommer med, ikke værdien.

Den virker ikke. Den eneste celle /lolllo der bliver ført over er mærkelig nok i kolonne K.

lollo skulle være kolonne :-)

prøv lige at sende projektmappen, skriv lige i emailen, hvilket modul din kode ligger i.

kabbak snabela tiscali dot dk

eller prøv denne :
Sub Hent()

Set sh1 = Sheets("Ark1")'ret evt. navn
Set sh2 = Sheets("Ark2")'ret evt. navn
r1 = sh1.Cells(65500, 1).End(xlUp).Row
For t = 2 To r1
r2 = sh2.Cells(65500, 1).End(xlUp).Row + 1
If IsNumeric(sh1.Cells(t, "C")) Or IsNumeric(sh1.Cells(t, "D")) Then
For tt = 1 To 15
sh2.Cells(r2, tt) = sh1.Cells(t, tt).Formula
Next
End If
Next

End Sub

Ok prøv at teste


    Data = .Range("A5:I" & .Range("B7000").End(xlUp).Row + 1) ' variabel med tal
    Data1 = .Range("A5:I" & .Range("B7000").End(xlUp).Row + 1).Formula ' variabel med formler


og længere nede

poster(K, 0) = Data(J, 1)

            poster(K, 2) = Data(J, 2)

            poster(K, 4) = Replace(Data1(J, 3), "A" & J + 4, "A" & K + 5) ' oversætter formler, spå de peger på rigtige celle

            poster(K, 6) = Replace(Data1(J, 5), "A" & J + 4, "A" & K + 5)

            poster(K, 8) = Data1(J, 7)

            poster(K, 10) = Data(J, 8)

Så hvis du vil have formler bruger du Data1
men husk at oversætte formler så di peger på den rette celle.

Hvis du vil have tal bruger du Data.

Public Sub HentKonto()
    Dim Data As Variant, Data1 As Variant, Poster() As Variant, I As Long, X As Integer
    Dim Antal As Long, K As Long
    With Worksheets("konto")
        Application.ScreenUpdating = False

        RW = .Range("A7000").End(xlUp).Row + 1
        Data = .Range("A5:O" & RW)    ' variabel med tal
        Data1 = .Range("A5:O" & RW).Formula    ' variabel med formler
    End With
    Antal = UBound(Data, 1)
    On Error Resume Next
    For I = 1 To UBound(Data, 1)
        If Data(I, 3) = 0 And Data(I, 5) = 0 Then
            Data(I, 1) = Empty
            Antal = Antal - 1
        End If
    Next
    ReDim Poster(Antal, UBound(Data, 2) - 1)
    K = 0

    For I = 1 To UBound(Data, 1)
        If Not IsEmpty(Data(I, 1)) Then
            For X = 1 To UBound(Data, 2) - 1
                Poster(K, X - 1) = Replace(Data1(I, X), I + 4, K + 5)

            Next
            K = K + 1
        End If
    Next
    With Worksheets("ark1")    ' ret til det ark du vil have det i
        Range(Range("A5"), ActiveCell.SpecialCells(xlLastCell)).ClearContents
        .Range("A5").Resize(UBound(Poster, 1), UBound(Poster, 2)) = Poster
    End With
    Application.ScreenUpdating = True

End Sub

Yes, den sidste sad lige i øjet. Har du et svar?

et svar ;-))

ret lige
  Range(Range("A5"), ActiveCell.SpecialCells(xlLastCell)).ClearContents

til
  .Range(Range("A5"), ActiveCell.SpecialCells(xlLastCell)).ClearContents