Kan det gøres mere simpel

Er det en værdi eller tekst du skal flytte ??? så kan du lave disse linier om:
    Sheets("PC250-Indtræk").Select
    Range("B29").Select
    Selection.Copy
    Sheets("Data").Select
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
til
Sheets("Data").Range("A2").Value = Sheets("PC250-Indtræk").Range("B29").Value

det var et svar

Det er tal, som skal kopieres fra en fane til en anden.
Og det skal gøres med 1 linie for hver værdi, som skal kopieres.

Jeg har 15 faner, hvor der skal kopiers 8 værdier. De 8 værdier er placeret i samme celle i hver fane.

Så laver du jo bare søg og erstat på "Data" når du har kørt den første gang...

Tak Flemming.

Jeg tror jeg vil lave dit svar, som 8 * 14 linier for hver fane så kan jeg have et bedre overblik over det.

/dan

vent lige.... jeg skal lige kigge i noget jeg næsten havde glemt.. øjeblik

Public Sub Tralala()
    Dim sNames(1 To 8) As String
    Dim lNumberOfStartCells As Long
    Dim lCount As Long

    sNames(1) = "Ark1"
    sNames(2) = "Ark2"
    'OSV....til 8 styk
   
    For lCount = 1 To UBound(sNames)
        With Sheets(sNames(lCount))
            .Range("A2").Value = Sheets("PC250-Indtræk").Range("B29").Value
            .Range("A3").Value = Sheets("PC250-Indtræk").Range("B75").Value
            ' OSV alle 14 linier eller flere
        End With
    Next lCount
End Sub

Jeg tror ikke jeg kan bruge dit sidste forslag :-((

Problemstilling:
15 Faner - PC250-indtræk, PC200-, PC210-, PC220-, osv.
I eks. PC250-indtræk celle b29, b75, osv (+46). kopieres til Data A2-A14. celle b15, b61 (+46) kopieres til B2-B14.
Dette skal gøres med endnu 6 værdier - celler springer altid med 46.
Når PC250 er 'færdig' skal næste fanes værdier placeres fra række 15-27 osv.
Og alle celler er altid ens - dvs. B29 og B15 skal hentes i alle 15 faner.

Håber det er bedre forklaret ??

Kolonne A startes i række 29
Kolonne B startes i række 15
Hvor starter kolonne C,D,E,F,G,H ?

Hvis du giver mig det fulde billede af et ark - så har jeg lige en finte til dig.

Skift selv tallene ud for kolonne C-H

Public Sub Tralala()
    Dim sNames(1 To 15) As String
    Dim lNumberOfStartCells As Long
    Dim lRows As Long
    Dim lColumns As Long
    Dim lNextRow As Long

    sNames(1) = "Ark1"
    sNames(2) = "Ark2"
    'OSV....til 15 styk
   
    For lColumns = 1 To 8
        ' A-kolonnen
        lNextRow = Sheets("Data").Range("A65536").End(xlUp).Row
        For lRows = 29 To 581 Step 46
            lNextRow = lNextRow + 1
            Sheets("Data").Range("A" & CStr(lNextRow)).Value = _
                Sheets(sNames(lCount)).Range("B" & CStr(lRows)).Value
        Next lRows
       
        ' B-kolonnen
        lNextRow = Sheets("Data").Range("B65536").End(xlUp).Row
        For lRows = 15 To 567 Step 46
            lNextRow = lNextRow + 1
            Sheets("Data").Range("B" & CStr(lNextRow)).Value = _
                Sheets(sNames(lCount)).Range("B" & CStr(lRows)).Value
        Next lRows
       
        ' C-kolonnen
        lNextRow = Sheets("Data").Range("C65536").End(xlUp).Row
        For lRows = 15 To 567 Step 46
            lNextRow = lNextRow + 1
            Sheets("Data").Range("C" & CStr(lNextRow)).Value = _
                Sheets(sNames(lCount)).Range("C" & CStr(lRows)).Value
        Next lRows
       
        ' D-kolonnen
        lNextRow = Sheets("Data").Range("D65536").End(xlUp).Row
        For lRows = 15 To 567 Step 46
            lNextRow = lNextRow + 1
            Sheets("Data").Range("D" & CStr(lNextRow)).Value = _
                Sheets(sNames(lCount)).Range("D" & CStr(lRows)).Value
        Next lRows
       
        ' E-kolonnen
        lNextRow = Sheets("Data").Range("E65536").End(xlUp).Row
        For lRows = 15 To 567 Step 46
            lNextRow = lNextRow + 1
            Sheets("Data").Range("E" & CStr(lNextRow)).Value = _
                Sheets(sNames(lCount)).Range("E" & CStr(lRows)).Value
        Next lRows
       
        ' F-kolonnen
        lNextRow = Sheets("Data").Range("F65536").End(xlUp).Row
        For lRows = 15 To 567 Step 46
            lNextRow = lNextRow + 1
            Sheets("Data").Range("F" & CStr(lNextRow)).Value = _
                Sheets(sNames(lCount)).Range("F" & CStr(lRows)).Value
        Next lRows
       
        ' G-kolonnen
        lNextRow = Sheets("Data").Range("G65536").End(xlUp).Row
        For lRows = 15 To 567 Step 46
            lNextRow = lNextRow + 1
            Sheets("Data").Range("G" & CStr(lNextRow)).Value = _
                Sheets(sNames(lCount)).Range("G" & CStr(lRows)).Value
        Next lRows
       
        ' H-kolonnen
        lNextRow = Sheets("Data").Range("H65536").End(xlUp).Row
        For lRows = 15 To 567 Step 46
            lNextRow = lNextRow + 1
            Sheets("Data").Range("H" & CStr(lNextRow)).Value = _
                Sheets(sNames(lCount)).Range("H" & CStr(lRows)).Value
        Next lRows
    Next lColumns
End Sub

Vil du gerne se arket ?

Fanen PC250-indtræk data hentet fra *.txt filer.
Jeg kopier så de tal, som jeg skal bruge over i fanen Data. Og henter derefter værdierne over i de rette skemaer.

ja, det er måske nemmere... fd@win-consult.com

Arket hermed sendt !!!!

sNames(1) = "PC250-Indtræk"
sNames(2) = "PC200"
sNames(3) = "PC210"
osv. for alle dine ark, som skal over på data.