如何使用 Application.WorksheetFunction.CountA 从 1 数到 31
how to use Application.WorksheetFunction.CountA to count sheets from 1 to 31
需要帮助 > 我尝试使用如何使用
Application.WorksheetFunction.CountA
从 1 数到 31
我做不到..任何帮助
我尝试的是:
number = Application.WorksheetFunction.CountA(Worksheets("1:31"))
完整代码:
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
感谢您的帮助
In VBA Thisworkbook.Worksheets.Count
给出工作簿中 VBA 为 运行 的工作表数。
我想做的是:
将表A复制到工作表(1,5,9,13,17,21,25,29)
然后
找到最后一行(在表 A 下)后将表 B 复制到同一张纸
就这些了
复制 Excel 相邻 Table 列
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
需要帮助 > 我尝试使用如何使用
Application.WorksheetFunction.CountA
从 1 数到 31
我做不到..任何帮助
我尝试的是:
number = Application.WorksheetFunction.CountA(Worksheets("1:31"))
完整代码:
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
感谢您的帮助
In VBA Thisworkbook.Worksheets.Count
给出工作簿中 VBA 为 运行 的工作表数。
我想做的是:
将表A复制到工作表(1,5,9,13,17,21,25,29) 然后 找到最后一行(在表 A 下)后将表 B 复制到同一张纸
就这些了
复制 Excel 相邻 Table 列
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