how to use Application.WorksheetFunction.CountA to count sheets from 1 to 31

Question

need help with that > i try to use how to use Application.WorksheetFunction.CountA to count sheets from 1 to 31

i can't do it .. any help

that what i try :

number = Application.WorksheetFunction.CountA(Worksheets("1:31"))

Full code:

Private Sub btnclone_Click()

Dim counter As Integer
Dim number As Long

number = Application.WorksheetFunction.CountA(Worksheets("1:31"))

 For counter = 1 To number Step 4
        ThisWorkbook.Sheets("NAME").Select
    Range("tblA[[CIVIL ID]:[LOCATION]]").Select
    Selection.Copy
    
    ThisWorkbook.Sheets("1").Select
    Range("A2").Select
    ActiveSheet.Paste
    
    ThisWorkbook.Sheets("NAME").Select
    Range("tblB[[CIVIL ID]:[LOCATION]]").Select
    Selection.Copy
    ThisWorkbook.Sheets("1").Select
    With Range("A:A").SpecialCells(xlCellTypeConstants)
    With .Areas
        With .Item(.Count)
            With .Cells
                .Item(.Cells.Count).Offset(1, 0).Select
            End With
        End With
    End With
End With
    ActiveSheet.Paste
    
    Next counter

End Sub

thanks for any help

Answer 1

Copy Excel Adjacent Table Columns

Option Explicit

Private Sub btnclone_Click()
    CopyTableColumns
End Sub

Sub CopyTableColumns()

    Const sName As String = "NAME"
    Const sCols1 As String = "tblA[[CIVIL ID]:[LOCATION]]"
    Const sCols2 As String = "tblB[[CIVIL ID]:[LOCATION]]"
    
    Const dfCellAddress As String = "A2"
    Const dFirst As Long = 1
    Const dStep As Long = 4
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim srg1 As Range: Set srg1 = sws.Range(sCols1)
    Dim srg2 As Range: Set srg2 = sws.Range(sCols2)
    
    Dim rCount1 As Long: rCount1 = srg1.Rows.Count
    Dim rCount2 As Long: rCount2 = srg2.Rows.Count
    Dim cCount As Long: cCount = srg1.Columns.Count
    
    Dim dLast As Long: dLast = GetHighestSheet(wb)
    If dLast < dFirst Then Exit Sub
    
    Dim dws As Worksheet
    Dim drg As Range
    Dim dfrrg As Range
    Dim d As Long
    
    For d = dFirst To dLast Step dStep
        On Error Resume Next
            Set dws = wb.Worksheets(CStr(d))
        On Error GoTo 0
        If Not dws Is Nothing Then
            Set dfrrg = dws.Range(dfCellAddress).Resize(, cCount)
            Set drg = dfrrg.Resize(rCount1)
            drg.Value = srg1.Value
            Set drg = drg.Resize(rCount2).Offset(rCount1)
            drg.Value = srg2.Value
            Set dws = Nothing
        End If
    Next d

End Sub

Function GetHighestSheet( _
    ByVal wb As Workbook) _
As Long
    
    Dim sh As Object
    Dim CurrentNum As Long
    Dim MaxNum As Long
    
    For Each sh In wb.Sheets
        If IsNumeric(sh.Name) Then
            CurrentNum = CLng(sh.Name)
            If CurrentNum > GetHighestSheet Then GetHighestSheet = CurrentNum
        End If
    Next sh
    
End Function