Kopier to kolonner fra en worksheet over i en ny workbook.

Forudsætter begge projektmapper er åbne og de har samme antal ark
Ark(1) E1:F100 i a.xls kopieres til Ark(1) E1:F100 i b.xls

Sub CopyEF()

Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("a.xls")
Set wb2 = Workbooks("b.xls")

For t = 1 To wb1.Sheets.Count
wb1.Sheets(t).Range("E1:F100").Copy Destination:=wb2.Sheets(t).Cells(1, "E")
Next

End Sub

derefter ark(2),ark(3) osv

workbook b eksistere ikke, men skal oprettes som en del af makroen. navnene på fanebladene på det enkelte worksheet skal med over i det nye ark. Navnet på den nye workbook skal dannes ud fra månedsnavnet + 1. Hvis workbook a hedder november, så skal den nye hedde december.

har du flere overraskelser inden jeg går i gang ?

Jeg har ikke så stor erfaring her på eksperten, så jeg har nok ikke udtryk mig klart nok i spørgsmålet, da jeg mente at det var naturligt at navnet på fanebladene kom med over.

ok jeg ser på det

prøv om denne kan bruges :

Sub CopyEF()

'gemmer først aktuel projektmappe
ThisWorkbook.Save

'find næste måneds navn
n = Left(ThisWorkbook.Name, 3)
For t = 1 To 12
If n Like Format(DateSerial(2007, t, 1), "mmm") Then
navn = Format(DateSerial(2007, t + 1, 1), "mmmm")
End If
Next

'sletter alle kolonner på nær E og F
For Each sh In ActiveWorkbook.Sheets
sh.Range("A1:D65535").Clear
sh.Range("G1:IV65535").Clear
Next

'gemmer med nyt navn
ActiveWorkbook.SaveAs navn & ".xls"

End Sub

Første del med at gemme og generee det nye navn virker ok, men sidste del virker ikke. Jeg får en fejl i linien sh.Range("A1:D65535").Clear. Det ser ud som om at det er sh der giver problemet. Hvad kan være årsagen?

umiddelbart gætter jeg på arkbeskyttelse, men jeg checker lige i mit testark

Der er ikke nogen beskyttelse på mit testark, men det er der på det ark som jeg skal bruge koden i.

beskyttelse kan vi slå til eller fra via koden
men fejler koden i et ikke beskyttet ark ?

ja det gør den. Jeg har lavet et ark med 3 sheets og så blot indsat noget tekst i de felter som jeg ønsker slettet. Koden stoppen ved linien: sh.Range("A1:D65535").Clear

kan du ikke sende dit testark til mig så kikker jeg på det
pm@madsen.tdcadsl.dk

Jeg har lige prøvet at med et helt nyt testark, og her virker den sjovt nok. Det tager blot lang tid, med at gennemføre sletningen. Vil det være hurtigere hvis man testede på hvor mange rækker der er på de enkelte ark, og derpå slette?
Når man kan slå beskyttelsen til og fra, kan man så på tilsvarende måde slå delingen til og fra?

Vedr. deling ved jeg ikke
Vedr. antal rækker så jo,
er alle kolonner fyldt lige langt ned
eller er der en kolonne der altid er flest udfyldte rækker i ?

Nej det er de ikke. Der er tale om et skema med rammer omkring. Hvis der tælles på kononne E og F, så vil det hele komme med. Der er ikke nogle kolonner der har flere rækker end de to førnævnte.

ok jeg prøver at ændre koden til det
men du er vel opmærksom på at filen gemmes 2 gange hvilket tager tid

Sub CopyEF()

'gemmer først aktuel projektmappe
ThisWorkbook.Save

'find næste måneds navn
n = Left(ThisWorkbook.Name, 3)
For t = 1 To 12
If n Like Format(DateSerial(2007, t, 1), "mmm") Then
navn = Format(DateSerial(2007, t + 1, 1), "mmmm")
End If
Next

'sletter alle kolonner på nær E og F
For Each sh In ActiveWorkbook.Sheets
rkE = sh.Cells(65500, "E").End(xlUp).Row
rkF = sh.Cells(65500, "F").End(xlUp).Row
If rkE < rkF Then rkE = rkF

sh.Range("A1:D" & rkE).Clear
sh.Range("G1:IV" & rkE).Clear
Next

'gemmer med nyt navn
ActiveWorkbook.SaveAs navn & ".xls"

End Sub

Det ser ud til at virke perfekt - og hurtigt. Tusinde tak for hjælpen.
Lægger du et svar?

ps. Hubertus er en af mine kollegaer, som har hjulpet lidt til med mit projekt.

ok velbekom