Makro til at tælle rækker i tabel2 og indsætte samme antal rækker i tabel1

Det kunne for eksempel gøres således:

Sub TableRows()
Range("Table1").Columns(1).Rows(2) = Range("Table2").Columns(1).Rows.SpecialCells(xlCellTypeVisible).Count
End Sub

Makroen tæller godt nok antallet af rækker i tabel2 og returnerer antallet i cellen, hvor der burde stå Total i tabel1, men den sætter ikke det ønskede antal rækker ind.

Jeg forstår ikke helt din kommentar. Hvis du mener den tæller forkert, kan det være du skal trække overskriften fra. Så ville den se således ud:

Sub TableRows()
Range("Table1").Columns(1).Rows(2) = Range("Table2").Columns(1).Rows.SpecialCells(xlCellTypeVisible).Count - 1.
End Sub

Og hvis du ønsker at tallet skal stå i en anden celle kan du blot ændre tallet efter Columns of Rows. Som den er nu sætter den tallet ind i 1. kolonne og 2, række

PS: Det er ikke dig der skal give svar. Det skal jeg, hvis det elllers lykkes for mig at give dig en tilfredsstillende løsning.

Da jeg prøvede makroen talte den, at der f.eks var 34 tabel rækker i tabel2, og det skrev den i tabel1 i den celle i tabellens nederste række yderst til venstre, hvor der før stod ordet Total.

Den skal ikke skrive tallet f.eks 34 nogen steder, men blot bruge antallet til at makroen indsætter 34 tomme rækker i tabel 1, når den har talt til 34 tabelrækker i tabel2.

34 er kun et eksempel det ændre sig fra søgning til søgning.

Ja, Jeg havde ikke fået læst opgaveformuleringen grundigt nok. Prøv med denne:

Sub TableRows()
Dim x, y As Double
Dim Tbl As ListObject
y = Range("Table1").Columns.Count
If Range("Table1").Rows.Count > 1 Then
ActiveSheet.ListObjects("Table1").DataBodyRange.EntireRow.Delete
End If
x = ActiveSheet.ListObjects("Table2").DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible).Count
Set Tbl = ActiveSheet.ListObjects("Table1")
With ActiveSheet.ListObjects("Table1")
    .Resize .Range.Resize(x + 1, y)
End With
End Sub

Tak for dit svar - det er jeg rigtig glad for - har dog ændret et par småting, men nu virker det i mit ark.

Send et svar til dine point!


Sub TableRows2()
Dim x, y As Double
Dim Tbl As ListObject
y = Range("Tabel1").Columns.Count
If Range("Tabel1").Rows.Count > 1 Then
ActiveSheet.ListObjects("Tabel1").DataBodyRange.EntireRow.Delete
End If
Sheets("Data").Select
x = ActiveSheet.ListObjects("Tabel2").DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible).Count
Sheets("Tabel1").Select
Set Tbl = ActiveSheet.ListObjects("Tabel1")
With ActiveSheet.ListObjects("Tabel1")
    .Resize .Range.Resize(x + 2, y)
End With
End Sub

Godt du kunne bruge den