[已解决]帮忙修改代码

huchuanxing

以下是把工作簿内各工作表数据合并到第一个工作表的VBA代码，不足之处是要首先手动新建一个工作表并把它放在工作表中的第一个位置，我想请论坛中 的朋友帮忙修改一下代码，让该代码运行时先自动创建一工作表，然后开始汇总数据到这工作表中。

Sub 把工作簿内所有工作表内容合并到第一个工作表中()

Dim i, n, St As Worksheet

    For i = 1 To Sheets.Count
        If i = 1 Then
            Set St = Sheets(i)
            If St.UsedRange.Cells.Count = 1 And St.Cells(1, 1) = "" Then
                n = 1 '下一次添加内容的行
            Else
                n = St.UsedRange.Rows.Count + 1
            End If
        Else
            Sheets(i).UsedRange.Copy St.Cells(n, 1)
            n = St.UsedRange.Rows.Count + 1
        End If
    Next i
End Sub

最佳答案

月排行榜 / 总排行榜

望帝春心

2016-11-5 08:47

huchuanxing 发表于 2016-11-4 21:45
望帝春心先生：您好！
        后来的代码我也进行了测试，问题还是存在，即“C”表有些项目（如班主任 ...

1. Sub Greenhand()
   
2.     Dim sht As Worksheet, flag As Boolean, i%, myrow%, myrow1%
   
3.     flag = False
   
4.     For i = 1 To Sheets.Count
   
5.         If Sheets(i).Name = "汇总表" Then flag = True
   
6.     Next
   
7.     If flag = False Then
   
8.         Set sht = Worksheets.Add
   
9.         sht.Name = "汇总表"
   
10.         Sheets("汇总表").Move before:=Sheets(1)
    
11.     End If
    
12.     For i = 1 To Sheets.Count
    
13.         If Sheets(i).Name <> "汇总表" Then
    
14.             myrow = Sheets("汇总表").UsedRange.Row
    
15.             myrow1 = Sheets("汇总表").UsedRange.Rows.Count
    
16.             If myrow1 = 1 Then
    
17.                 Sheets(i).UsedRange.Copy
    
18.                 Sheets("汇总表").Cells(myrow, 1).End(3).Select
    
19.                 Selection.PasteSpecial (xlPasteValues)
    
20.             Else
    
21.                 Sheets(i).UsedRange.Copy
    
22.                 Sheets("汇总表").Cells(myrow + myrow1 - 1, 1).Offset(1, 0).Select
    
23.                 Selection.PasteSpecial (xlPasteValues)
    
24.             End If
    
25.         End If
    
26.     Next i
    
27. End Sub

复制代码

跳转到最佳答案楼层

望帝春心

1. Sub Greenhand()
   
2.     Dim sht As Worksheet, flag As Boolean, i%, myrow%, myrow1%
   
3.     flag = False
   
4.     For i = 1 To Sheets.Count
   
5.         If Sheets(i).Name = "汇总表" Then flag = True
   
6.     Next
   
7.     If flag = False Then
   
8.         Set sht = Worksheets.Add
   
9.         sht.Name = "汇总表"
   
10.         Sheets("汇总表").Move before:=Sheets(1)
    
11.     End If
    
12.     For i = 1 To Sheets.Count
    
13.         If Sheets(i).Name <> "汇总表" Then
    
14.             myrow = Sheets("汇总表").UsedRange.Row
    
15.             myrow1 = Sheets("汇总表").UsedRange.Rows.Count
    
16.             If myrow1 = 1 Then
    
17.                 Sheets(i).UsedRange.Copy Sheets("汇总表").Cells(myrow, 1).End(3)
    
18.             Else
    
19.                 Sheets(i).UsedRange.Copy Sheets("汇总表").Cells(myrow + myrow1 - 1, 1).Offset(1, 0)
    
20.             End If
    
21.         End If
    
22.     Next i
    
23. End Sub

复制代码

请参考

huchuanxing

此代码我测试了一下，存在一个问题，即若其中一工作表中的数据是引用其它工作簿的，则汇总表中会显示为“0”,也就是说汇总数据会出现错误，请完善一下。谢谢。

爱疯

建议先上传附件

望帝春心

huchuanxing 发表于 2016-11-4 14:41
此代码我测试了一下，存在一个问题，即若其中一工作表中的数据是引用其它工作簿的，则汇总表中会显示为“0 ...

1. Sub Greenhand()
   
2.     Dim sht As Worksheet, flag As Boolean, i%, myrow%, myrow1%
   
3.     flag = False
   
4.     For i = 1 To Sheets.Count
   
5.         If Sheets(i).Name = "汇总表" Then flag = True
   
6.     Next
   
7.     If flag = False Then
   
8.         Set sht = Worksheets.Add
   
9.         sht.Name = "汇总表"
   
10.         Sheets("汇总表").Move before:=Sheets(1)
    
11.     End If
    
12.     For i = 1 To Sheets.Count
    
13.         If Sheets(i).Name <> "汇总表" Then
    
14.             myrow = Sheets("汇总表").UsedRange.Row
    
15.             myrow1 = Sheets("汇总表").UsedRange.Rows.Count
    
16.             If myrow1 = 1 Then
    
17.                 Sheets(i).UsedRange.Copy
    
18.                 Sheets("汇总表").Cells(myrow, 1).End(3).Select
    
19.                 Selection.PasteSpecial (xlPasteValues)
    
20.             Else
    
21.                 Sheets(i).UsedRange.Copy Sheets("汇总表").Cells(myrow + myrow1 - 1, 1).Offset(1, 0)
    
22.             End If
    
23.         End If
    
24.     Next i
    
25. End Sub

复制代码

huchuanxing

望帝春心 发表于 2016-11-4 13:02
请参考

望帝春心先生：您好！
        后来的代码我也进行了测试，问题还是存在，即“C”表有些项目（如班主任、课时、晚自习三项数据）是引用了“课时津贴计算”表中对应项目数据，在合并A、B、C三表时，汇总表中有关C表中的班主任、课时和晚自习三项仍然显示的是“0”，见《测试》附件。请帮忙解决。谢谢。

huchuanxing

huchuanxing 发表于 2016-11-4 21:45
望帝春心先生：您好！
        后来的代码我也进行了测试，问题还是存在，即“C”表有些项目（如班主任 ...

补附件

望帝春心

huchuanxing 发表于 2016-11-4 21:45
望帝春心先生：您好！
        后来的代码我也进行了测试，问题还是存在，即“C”表有些项目（如班主任 ...

1. Sub Greenhand()
   
2.     Dim sht As Worksheet, flag As Boolean, i%, myrow%, myrow1%
   
3.     flag = False
   
4.     For i = 1 To Sheets.Count
   
5.         If Sheets(i).Name = "汇总表" Then flag = True
   
6.     Next
   
7.     If flag = False Then
   
8.         Set sht = Worksheets.Add
   
9.         sht.Name = "汇总表"
   
10.         Sheets("汇总表").Move before:=Sheets(1)
    
11.     End If
    
12.     For i = 1 To Sheets.Count
    
13.         If Sheets(i).Name <> "汇总表" Then
    
14.             myrow = Sheets("汇总表").UsedRange.Row
    
15.             myrow1 = Sheets("汇总表").UsedRange.Rows.Count
    
16.             If myrow1 = 1 Then
    
17.                 Sheets(i).UsedRange.Copy
    
18.                 Sheets("汇总表").Cells(myrow, 1).End(3).Select
    
19.                 Selection.PasteSpecial (xlPasteValues)
    
20.             Else
    
21.                 Sheets(i).UsedRange.Copy
    
22.                 Sheets("汇总表").Cells(myrow + myrow1 - 1, 1).Offset(1, 0).Select
    
23.                 Selection.PasteSpecial (xlPasteValues)
    
24.             End If
    
25.         End If
    
26.     Next i
    
27. End Sub

复制代码

望帝春心

参考附件........

huchuanxing

问题解决了，谢谢您！