Avatar billede olesendan Nybegynder
10. februar 2015 - 15:58

VBA vælg tabel med wildcard hvis den findes på worksheet

Jeg forsøger at kigge en række af regneark igennem, hvis de starter med "@". Hvis der findes en tabel, der starter med "I" så skal den vælge alt dataen. Dataen skal så sættes ind på en oversigtsside.

JEg har fundet noget kode på nettet. Jeg har forsøgt at tilpasse den. Lige nu er jeg låst ved at den ikke kan finde tabel med wildcard.

Er der nogen som kan gennemskue, hvad jeg gør forkert

Koden ser ud som nedenstående:

Sub CopyRangeFromMultiWorksheets()
    Dim Wb As ThisWorkbook
    Dim Ws As Worksheet
    Dim DestWs As Worksheet
    Dim Last As Long
    Dim CopyRng As Range
    Dim CopyLst As ListObject
    Dim DestLst As ListObject

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    Set Wb = ThisWorkbook
   
    Set DestWs = Wb.Worksheets("DashBoard")
   
    'loop through all worksheets and copy the data to the DestSh
    For Each Ws In Wb.Worksheets
        If LCase(Left(Ws.Name, 1)) = "@" Then 'Denne code kigger alle Ws som starter med @ igennem
       

            'Find the last row with data on the DestWs
            Last = LastRow(DestWs)
 
            Set CopyLst = Ws.ListObjects("Issues*")
            If Not CopyLst.DataBodyRange Is Nothing Then
                CopyLst.DataBodyRange.Select
                           
            'On Error Resume Next
            'Set CopyLst = Ws.ListObjects("Issues*").DataBodyRange.Select
           
           
            'Nedenstående er * for at teste TAbel
            'Test if there enough rows in the DestWs to copy all the data
            If Last + CopyRng.Rows.Count > DestWs.Rows.Count Then
                MsgBox "There are not enough rows in the DestWs"
                GoTo ExitTheSub
            End If

            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            CopyLst.Copy
            With DestWs.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
            'Optional: This will copy the sheet name in the H column
            DestWs.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = Ws.Name
            End If
        End If
    Next

ExitTheSub:

    Application.Goto DestWs.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestWs.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub



Venlig Hilsen
Dan Olesen
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester