如何解决将包含多于 X 行数据的工作表复制到另一个工作簿
我在一本工作簿 (A) 中有 100 个工作表。我想将包含超过 35 行数据的工作表复制到工作簿 (B) 中。
我编写的代码复制了少于 35 行数据的工作表。
Sub Split_workbook()
Dim last_row as long
Dim sh as worksheet
For Each sh In Worksheets
last_row = cells(rows.count,"A").End(xlUp).Row
If last_row >= 35 Then
sh.copy after:=workbooks("B.xlsx").Sheets(Workbooks("B.xlsx").Sheets.count)
End if
Workbooks("A.xlsx").activate
Next sh
End Sub
解决方法
复制工作表
- 从一个工作簿 (
ThisWorkbook
) 运行代码,将某些工作表从另一个打开的工作簿 (A.xlsx
) 复制到另一个(第三个)打开的工作簿 (B.xlsx
)。立>
代码
Option Explicit
Sub splitWorkbook()
Const ProcName As String = "splitWorkbook"
On Error GoTo clearError
Const srLimit As Long = 35
Dim swb As Workbook: Set swb = Workbooks("A.xlsx")
Dim srCount As Long: srCount = swb.Worksheets(1).Rows.Count
Dim dwb As Workbook: Set dwb = Workbooks("B.xlsx")
Dim sws As Worksheet
Dim sLastRow As Long
Dim dCount As Long
Application.ScreenUpdating = False
For Each sws In swb.Worksheets
sLastRow = sws.Cells(srCount,"A").End(xlUp).Row
If sLastRow >= srLimit Then
dCount = dCount + 1
sws.Copy After:=dwb.Sheets(dwb.Sheets.Count)
End If
Next sws
'swb.Close False
'dwb.Close True
ProcExit:
If Not Application.ScreenUpdating Then
Application.ScreenUpdating = True
End If
Select Case dCount
Case 0
MsgBox "No worksheets copied.",vbExclamation,"Fail?"
Case 1
MsgBox "Copied 1 worksheet.",vbInformation,"Success"
Case Else
MsgBox "Copied " & dCount & " worksheets.","Success"
End Select
Exit Sub
clearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Sub
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。