udprint i excel

Jeg kigger på det.

lav et område på samme ark der ikke umiddelbart ses på skærmen og brug =, altså f.eks hvis du vil have at a1 skal være lig k5 - klik på k5 og klik på = klik derefter på a1 og tryk enter - så alt hvad der indtastes i a1 vil fremkomme i k5 og så fremdeles - selvfølgelig stort arbejde hvis du har mange rækker i brug - men en løsning

du definere så området k5:XX som udskriftsområde

Kan problemet ikke løses med en formel?
Noget i retning af:
=HVIS(B5<>0;SÅ OVERFØR RÆKKE;OVERFØR IKKE RÆKKE)

Hvis alle de overførte SKAL stå lige under hinanden uden tomme rækker skal der dog en simpel lille makro til.
Eller måske behøver man ikke engang VBA-kode, men kan klare problemet med en lidt snørklet formel.

Det kommer lidt an på, hvordan dit ark ser ud.
Har du muligehed for at sende det til jan_vogt_hansen@hotmail.com så skal jeg kigge på det.

Denne makro løser problematikken fint

Sub FlytDataLinie()
Dim sDataFra As String
Dim sDataTil As String

    \'Angiv navne på de ark du har
    sDataFra = \"DataArk\" \'Udskift til dit arknavn
    sDataTil = \"PrintArk\" \'Udskift til dit arknavn

    \'Checker B5
    Worksheets(sDataFra).Select
    If Worksheets(sDataFra).Range(\"B5\") <> \"\" Then
   
        \'Finder næste tomme linie på PrintArket
        Worksheets(sDataTil).Select
        Range(\"B65000\").End(xlUp).Offset(1).Select
        ActiveCell.Offset(0, -1).Select
       
        ActiveCell.Offset(0, 0) = Worksheets(sDataFra).Range(\"A5\")
        ActiveCell.Offset(0, 1) = Worksheets(sDataFra).Range(\"B5\")
        ActiveCell.Offset(0, 2) = Worksheets(sDataFra).Range(\"C5\")
        ActiveCell.Offset(0, 3) = Worksheets(sDataFra).Range(\"D5\")
        ActiveCell.Offset(0, 4) = Worksheets(sDataFra).Range(\"E5\")
        ActiveCell.Offset(0, 5) = Worksheets(sDataFra).Range(\"F5\")
       
        MsgBox \"Data er flyttet\"
   
    Else
       
        MsgBox \"Celle B5 = 0. Data er ikke flyttet.\"
       
    End If

End Sub

Hovsa....

I denne sektion skal du udskrifte \"\" med 0
    \'Checker B5
    Worksheets(sDataFra).Select
    If Worksheets(sDataFra).Range(\"B5\") <> \"\" Then

således:
    \'Checker B5
    Worksheets(sDataFra).Select
    If Worksheets(sDataFra).Range(\"B5\") <> 0 Then
   
           
       

tak til flemmingdahl

velbekomme :-)

Ovenstående makro flytter vel kun række 5 ?

Så vidt jeg kan se af spørgsmålet er der behov for en løkke som gennemløber mange rækker og overflytter ALLE de rækker, hvor værdien i kolonne B er forskellig fra 0.

>>> toyotahiace

Har jeg ret i min betragtning?
Selvom pointene er fordelt er spørgsmålet vel ikke besvaret, eller?

>>>jan vogt
Du har fuldstændig ret, der er brug for et eller andet loop men jeg ændrede bare \"lidt\" i makroen og kopierede den det antal gange som jeg havde linier der skulle flyttes, og det virker tilsyneladene perfekt.

Skal det laves på check af indhold i kolonne B ?
Så gør jeg da gerne det.

>>>> flemming dahl
Ja akkurat, det er kolonne B der afgør om data skal flyttes

Jeg kigger på det i aften.

Here you are :-)

Sub FlytDataLinie_02()
Dim iTomRowNo As Integer, iX As Integer
Dim wsDataFra As Worksheet, wsDataTil As Worksheet
Dim rCell As Range

    \'Angiv navne på de ark du har
    Set wsDataFra = Worksheets(\"DataArk\")
    Set wsDataTil = Worksheets(\"PrintArk\")

    \'Finder næste tomme linie på PrintArket
    wsDataTil.Select
    iTomRowNo = Range(\"B65000\").End(xlUp).Row

    \'Checker B-kolonnen i DataArk fra linie 5 til 500
    wsDataFra.Select
    For Each rCell In wsDataFra.Range(\"B5:B500\")
        If rCell <> 0 Then
            iX = iX + 1
            wsDataTil.Range(\"A\" & iTomRowNo + iX).Value = rCell.Offset(1, -1)
            wsDataTil.Range(\"B\" & iTomRowNo + iX).Value = rCell.Offset(1, 0)
            wsDataTil.Range(\"C\" & iTomRowNo + iX).Value = rCell.Offset(1, 1)
            wsDataTil.Range(\"D\" & iTomRowNo + iX).Value = rCell.Offset(1, 2)
            wsDataTil.Range(\"E\" & iTomRowNo + iX).Value = rCell.Offset(1, 3)
            wsDataTil.Range(\"F\" & iTomRowNo + iX).Value = rCell.Offset(1, 4)
        End If
    Next rCell

End Sub

>>> Flemmingdahl.
Super, det funker :-) tusind tak.