Vba 将前两列从所有图纸复制到主图纸的宏正在跳过图纸

我正在使用此宏将所有工作表中的A列和B列复制到名为Master的新工作表中。我注意到的是，主控表中缺少完整的信息表，我不知道为什么。我的工作表的格式是A列有一个字符串，该字符串遵循以下结构：M2004005004007,17096,01:07:45,45，B列只是一个日期，如2017年4月19日

我的工作簿中有数百张这样的工作表，每一张都有224行，我需要将它们复制到一张主工作表中。有谁能帮我弄清楚如何让这段代码停止跳过工作表吗

谢谢

Sub CreateMaster()

Dim J As Integer

On Error Resume Next

Sheets(1).Select

Worksheets.Add

Sheets(1).Name = "Master"

Sheets(2).Activate

Range("A1:B1").EntireRow.Select

Selection.Copy Destination:=Sheets(1).Range("A1:B1")

For J = 2 To Sheets.Count

Sheets(J).Activate

Range("A1:B1").Select

Selection.CurrentRegion.Select

Selection.Copy Destination:=Sheets(1).Range("A65536:B65536").End(xlUp)(2)

Next

End Sub

在网上搜索解决方案时，我发现这个宏似乎做了同样的事情，但似乎也跳过了与我的宏完全相同的工作表

工作表（）的子副本

变数

Dim sht As Worksheet 'Object for handling worksheets in loop

Dim trg As Worksheet 'Master Worksheet

Dim rng As Range 'Range object

Dim colCount As Integer 'Column count in tables in the worksheets

Set wrk = ActiveWorkbook 'Working in active workbook

For Each sht In wrk.Worksheets 
    If sht.Name = "Master" Then 
        MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ 
        "Please remove or rename this worksheet since 'Master' would be" & _ 
        "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" 
        Exit Sub 
    End If 
Next sht 

 'We don't want screen updating
Application.ScreenUpdating = False 

 'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 
 'Rename the new worksheet
trg.Name = "Master" 
 'Get column headers from the first worksheet
 'Column count first
Set sht = wrk.Worksheets(1) 
colCount = sht.Cells(1, 255).End(xlToLeft).Column 
 'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount) 
    .Value = sht.Cells(1, 1).Resize(1, colCount).Value 
     'Set font as bold
    .Font.Bold = True 
End With 

 'We can start loop
For Each sht In wrk.Worksheets 
     'If worksheet in loop is the last one, stop execution (it is Master worksheet)
    If sht.Index = wrk.Worksheets.Count Then 
        Exit For 
    End If 
     'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 
     'Put data into the Master worksheet
    trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 
Next sht 
 'Fit the columns in Master worksheet
trg.Columns.AutoFit 

 'Screen updating should be activated
Application.ScreenUpdating = True 

端接头

---

作为一种变通方法，因为只有最新的数据才是直接相关的，所以我对其进行了变通，但删除了前150页。这仍然为我的宏留下了大约100张工作表，但现在丢失的数据似乎就在那里。我想知道是不是纸张的数量导致了这种故障？

评论可能无法正确理解。重新构造循环（并添加提到的变量）

---

如果您删除了错误恢复下一步时的

，是否仍会跳过它们？是。我刚试过，它继续跳过相同的表格。当你为每一张表格做计算时，它不一定按数字顺序进行。尝试将循环更改为执行以下操作：将x=1的Thisht作为工作表变暗为wrk.Worksheet.Count设置Thisht=wrk.worksheets（x）Ok。那些床单有什么奇怪的吗？例如A1:B1或相邻单元格中的数据？它们可能是隐藏行还是受保护的表？我倾向于将其中的一张作为书中唯一的一张，然后看看会发生什么。任何一张都没有什么特别之处。这只是一年来收集的数据。莉丝帮我把事情弄明白了。谢谢你的帮助。我不知道默认情况下它不会按数字顺序排列。很明显，我对vba很陌生，所以我非常感谢你的帮助。谢谢。等等，问题不是跳过了工作表，而是数据的粘贴顺序与您预期的不同？还是我遗漏了什么？
Dim sht As Worksheet 'Object for handling worksheets in loop

Dim trg As Worksheet 'Master Worksheet

Dim rng As Range 'Range object

Dim colCount As Integer 'Column count in tables in the worksheets

Set wrk = ActiveWorkbook 'Working in active workbook

For Each sht In wrk.Worksheets 
    If sht.Name = "Master" Then 
        MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ 
        "Please remove or rename this worksheet since 'Master' would be" & _ 
        "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" 
        Exit Sub 
    End If 
Next sht 

 'We don't want screen updating
Application.ScreenUpdating = False 

 'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 
 'Rename the new worksheet
trg.Name = "Master" 
 'Get column headers from the first worksheet
 'Column count first
Set sht = wrk.Worksheets(1) 
colCount = sht.Cells(1, 255).End(xlToLeft).Column 
 'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount) 
    .Value = sht.Cells(1, 1).Resize(1, colCount).Value 
     'Set font as bold
    .Font.Bold = True 
End With 

 'We can start loop
For Each sht In wrk.Worksheets 
     'If worksheet in loop is the last one, stop execution (it is Master worksheet)
    If sht.Index = wrk.Worksheets.Count Then 
        Exit For 
    End If 
     'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 
     'Put data into the Master worksheet
    trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 
Next sht 
 'Fit the columns in Master worksheet
trg.Columns.AutoFit 

 'Screen updating should be activated
Application.ScreenUpdating = True 

Dim x as Long
Dim thisSht as Worksheet

For x = 1 to wrk.Worksheets.Count
    set thisSht = wrk.Worksheets(x)
     'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    Set rng = thisSht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 
     'Put data into the Master worksheet
    trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 
Next x