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
