Flytte alle ark til et Opsamlings ARK

Jeg skal lige være sikker, du mener alle ark i samme excel fil?
Eller mener du ark i forskellige filer i en mappe på harddisken?

Hej Thomas_bk
Ja alle Arkene jeg har lavet to filer en der hedder Opsamling Før hvor du kan se der ikke er andre faneblade i VPL 2021. Har lige rettet den de var ens :-)

Det er her jeg gerne skulle kunne trykke på min blå knap Overføre Ark. Og når jeg gør det skulle Arket gerne se ud som Filen Opsamling Efter. Jeg har kun taget nogle med der vil normalt være mellem 39 og 45 ark.

Håber det er forståelig.
https://www.dropbox.com/t/3FHgWIIZqhwrTQhr
Hilsen Klaus W

Af sikkerhedsmæssige hensyn så åbner jeg ikke lige din fil.
Jeg bruger selv nedenstående kode, den kan du prøve i en test fil og efterfølgende evt koble til en knap.

Sub kopier_ark_til_oversigt()

' Kopier indholdet af worksheets til nyt sheet med navnet Oversigt

Dim ws As Worksheet
Dim oversigt As Worksheet
Dim counter As Long
Dim ans As Integer

ans = MsgBox("Arket Oversigt bliver slettet!!" & vbNewLine & vbNewLine & "Ønsker du at forsætte?", vbYesNo)
Select Case ans
Case vbYes
    GoTo runsub
Case vbNo
    Exit Sub
End Select

runsub:

Application.ScreenUpdating = False
Application.DisplayAlerts = False

counter = 0

On Error Resume Next
Worksheets("oversigt").Delete
On Error GoTo 0

Worksheets.Add().Name = "Oversigt"

Set oversigt = Worksheets("Oversigt")

For Each ws In Worksheets
  If ws.Name <> "Oversigt" Then
    ws.UsedRange.Copy oversigt.Cells(oversigt.UsedRange.Rows.Count + counter, 1)
    counter = counter + 2
  End If
Next ws

With Sheets("Oversigt")
  .Columns.AutoFit
  .Activate
End With

Application.CutCopyMode = False

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Hej Thomas

Jeg for den desværre ikke til at køre, en fejl i Worksheets.Add().Name = "Oversigt"
Koden må helst ikke slette min opsamlings ark. Da det skal bruges.

KW

I mit eksempel sletter den Oversigts arket med henblik på at lave et nyt.
Hvis du har behov for det kan du blot ændre til 'Opsamling' eller hvad du har behov for.

Hej Thomas jeg kan ikke få den til at fungere

Jeg lukker og laver et nyt spørgsmål.

Tak for din tid og hjælp

Klaus w

Hej igen Thomas
Jeg fandt en løsning på nettet.
Endnu engang tak.

Klaus w