求代码无法运行原因

菊子红了

我需要汇总多表到一表里，单元格BA3:BA13的内容行转成列，对应排列在AW17:BG17列的上方。
所有汇总内容向右排列，保持原有的条件格式不变。

我有现成的一组代码，有时能运行，有时运行报错，请大神指点错误原因或帮忙重新写代码，谢谢！

Sub huizong()
Application.DisplayAlerts = False
a = Dir("C:\Users\tqc-003\Desktop\001\*.xls")
Dim b As Worksheet
Do While a <> ""
Debug.Print a
Set b = ActiveWorkbook.Sheets.Add
Set new_ex = Workbooks.Open("C:\Users\tqc-003\Desktop\001\" & a)
Dim arr, brr

Dim frr(1 To 11)
Dim hrr(1 To 11)
arr = new_ex.Sheets("Report").Range("BA3:BA13")
brr = new_ex.Sheets("Report").Range("BB3:BB13")

For i = 1 To UBound(arr)
    frr(i) = arr(i, 1) & brr(i, 1)
    b.Range("A3").Offset(0, i -1) = frr(i)
   Next
new_ex.Sheets("Report").Range("AW17:BG150").Copyb.Range("A7")

new_ex.Close
a = Dir
Loop
Dim huizongbiao As Worksheet
Set huizongbiao = Sheets.Add
huizongbiao.Name = "H"
huizongbiao.Range("a2").Value = 1
For Each sht In Sheets
If sht.Name <> "H" Then
sht.Select
ActiveSheet.UsedRange.Select
Selection.Copy Sheets("H").Range("A2").Offset(0,(Sheets("H").Range("dzz2").End(xlToLeft).Column))
End If
Next
For Each i In Sheets
If i.Name <> "H" And i.Name <> "Sheet2" Then
i.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

菊子红了

求大神帮助！

zhenghui13

菊子红了 发表于 2024-12-18 10:49
求大神帮助！

没有测试，看看
下面Copyb拼错了。
new_ex.Sheets("Report").Range("AW17:BG150").Copyb.Range("A7")
判断sheet name是不是用Or更好。
If i.Name <> "H" And i.Name <> "Sheet2" Then是不是改成
If i.Name <> "H" Or i.Name <> "Sheet2" Then

chxw68

错误挺多，修改后不出错了。

菊子红了

谢谢大神，我对比查看一下错误点，向大神学习！