Makro - løkke - gentager procedure indtil rækker er tomme
Jeg har en makro optaget, det skal gentages indtil ca. 600 rækker er kørt igennem. Så hvordan koder jeg at makroen efter fuldførelse af proceduren går til næste linie, og senere næste linie igen. Men samtidig sådan at hvis linien er tom at proceduren stopper.
Jeg har vedlagt den indledende procedure. Sub pensionsplanner2() ' ' pensionsplanner2 Makro ' Makro indspillet 29.12.2005 af Hans Henrik '
' Range("A2:D2").Select Selection.Copy Windows("pensionsplanner.xls").Activate Range("C3").Select ActiveSheet.Paste Range("C2:F4").Select Application.CutCopyMode = False Application.ActivePrinter = "hp deskjet 450 printer på Ne01:" ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _ "hp deskjet 450 printer på Ne01:", Collate:=True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Windows("data ark .xls").Activate ' her stopper procedureen for 1 række
Range("A3:D3").Select Selection.Copy Windows("pensionsplanner.xls").Activate Range("C4").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End Sub
Jeg manglede lige et par kommentarer. Range("A2:D2").Select Selection.Copy Windows("pensionsplanner.xls").Activate Range("C3").Select ActiveSheet.Paste Range("C2:F4").Select Application.CutCopyMode = False Application.ActivePrinter = "hp deskjet 450 printer på Ne01:" ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _ "hp deskjet 450 printer på Ne01:", Collate:=True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Windows("data ark .xls").Activate ' her stopper procedureen for 1 række ' her starter procedure for 2. række Range("A3:D3").Select Selection.Copy Windows("pensionsplanner.xls").Activate Range("C4").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End Sub I håb om et godt svar
Sub test() Dim x As Long Dim mySh2 As Worksheet Dim mySh1 Set mySh1 = Workbooks("data ark .xls").ActiveSheet Set mySh2 = Workbooks("pensionsplanner.xls").ActiveSheet x = 2 Do While mySh1.Range("A" & x) <> "" mySh1.Range("A" & x & ":D" & x).Copy mySh2.Range("C" & x + 1) mySh2.PrintOut Copies:=1, ActivePrinter:= _ "hp deskjet 450 printer på Ne01:", Collate:=True x = x + 1 Loop End Sub
Tak for dit input. Det virker godt. Men der var nok en ting jeg glemte at fortælle: Data fra data ark skal placeres det samme sted i pensionsplanner - når data kommer over i pensionplanner skal der startes nogle beregninger som typisk tager 30 sek., og det er bla. resultatet af disse beregninger, der skal udskrives og proceduren skal kører igen. Jeg ved godt jeg ikke var skarp nok i min indledning, der signalerede jeg faktisk noget andet.
ok, er det sådan at det skal være helt automatisk eller vil du trykke på en knap, for at få den til at køre hver gang ? Med samme sted, mener du da at hvis data tages fra A10:D10 så skal de også placeres i A10:D10 eller skal det hver gang være i fx C3 Nedenståede placerer det i C3 hver gang
I øvrigt lyder en beregning på 30 sek. som noget der kunne tåle en del optimering :-)
Sub test() Dim x As Long Dim mySh2 As Worksheet Dim mySh1 Set mySh1 = Workbooks("data ark .xls").ActiveSheet Set mySh2 = Workbooks("pensionsplanner.xls").ActiveSheet x = 2 Do While mySh1.Range("A" & x) <> "" mySh1.Range("A" & x & ":D" & x).Copy mySh2.Range("C3") mySh2.PrintOut Copies:=1, ActivePrinter:= _ "hp deskjet 450 printer på Ne01:", Collate:=True x = x + 1 Loop End Sub
Tak for tilbagemeldingen. det meste er selvlært, men jeg ahr da haft glæde af et par bøger af john walkenbach, en kendt excel guru.
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.
