[已解决]怎么用宏实现多表合并

bopynnvtkd

怎么用宏实现多表和并。附件里的表1/表2/表3/表4/自动合并成生产报表。如果下次有表5/表6/表7。。。。一直表100的放在一起。自动合并成生产报表的模式。在线等待。谢谢各位大虾！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-7-6 21:02

其实数字偏长的你在前面加个单引号问题就解决了，昨天合并后我就看到了。

跳转到最佳答案楼层

hwc2ycy

昨天不是帮你写过一个么，今天要求变了？

hwc2ycy

其实数字偏长的你在前面加个单引号问题就解决了，昨天合并后我就看到了。

bopynnvtkd

hwc2ycy 发表于 2013-7-6 21:02
其实数字偏长的你在前面加个单引号问题就解决了，昨天合并后我就看到了。

你好：因为我是新手。。所以朋友的教我不懂呐。需要朋友整个编码呢{:041:}

桐君山7717

我也想学学

bopynnvtkd

hwc2ycy 发表于 2013-7-6 21:02
其实数字偏长的你在前面加个单引号问题就解决了，昨天合并后我就看到了。

• Sub 合并工作表()
•     Dim strPath As String, strFile As String
•     Dim objwb As Workbook, rg As Range
•     Dim arr, strMsg As String
•     On Error GoTo ErrorHandler
•     With Application
•         .ScreenUpdating = False
•         .DisplayAlerts = False
•         .EnableEvents = False
•         .Calculation = xlCalculationManual
•     End With
•     strPath = ThisWorkbook.Path & Application.PathSeparator
•     strFile = Dir(strPath & "*.xls")
•     Do While Len(strFile)
•         Set rg = Sheet1.Cells(Rows.Count, 1).End(xlUp)
•         If strFile <> ThisWorkbook.Name Then
•             strMsg = strMsg & strFile & vbCr
•             With GetObject(strPath & strFile)
•                 If rg.Row <> 1 Then
•                     arr = .Worksheets("sheet1").UsedRange.Offset(1).Value
•                 Else
•                     arr = .Worksheets("sheet1").UsedRange.Value
•                 End If
•                 Windows(.Name).Visible = True
•                 .Close False
•             End With
•             If rg.Row = 1 Then
•                 rg.Resize(UBound(arr), UBound(arr, 2)).Value = arr
•             Else
•                 rg.Offset(1).Resize(UBound(arr), UBound(arr, 2)).Value = arr
•             End If
•         End If
•         strFile = Dir
•     Loop
•     With rg.CurrentRegion.Borders
•         .LineStyle = 1
•         .ColorIndex = 16
•     End With
•     With Application
•         .ScreenUpdating = True
•         .DisplayAlerts = True
•         .EnableEvents = True
•         .Calculation = xlCalculationAutomatic
•     End With
•     If Len(strMsg) Then
•         MsgBox "合并完成" & vbCrLf & "导入的文件如下：" & vbCrLf & strMsg
•     End If
•     Exit Sub
• ErrorHandler:
•     MsgBox Err.Number & vbCrLf & Err.Description
•     Err.Clear
•     If ActiveWorkbook.Name <> ThisWorkbook.Name Then
•         ActiveWorkbook.Close False
•     End If
• End Sub
  

ligh1298

楼主：是不是想要这样的？见附件！

bopynnvtkd

ligh1298 发表于 2013-7-6 21:43
楼主：是不是想要这样的？见附件！

亲你那只有表格文本格式呐。