VBA新人求教VBA条件复制问题

vai671

现在要实现如图，将选中要处理的工作簿中所有表在本SHEET1表 A2单元格列数中为B2单元格日期的行（a列开始最多30列的数据）依次复制到本sheet1表3行之后（或新建一个表用来放数据）
并将A列数据改成对应数据来源的表名称；用来做当日汇总表。
网上找了些模板，能再这个基础上完成吗？
Sub my模板()
Dim ShApp As Object, mysheet As ObjectDim TF As Boolean, i As Integer, x As Integer
Dim aTable As Object, n As Integer
On Error Resume Next
n = 0
With Application.FileDialog(msoFileDialogFilePicker)
       .Title = "请选定要处理的excel文档"
       .Filters.Add "excel文档", "*.xlsx"  '暂定扩展名为xlsx的excel文档
       .AllowMultiSelect = True
       If .Show <> -1 Then Exit Sub
       Set ShApp = GetObject(, "Excel.Application")
       If Err <> 0 Then
           TF = True
           Set ShApp = CreateObject("Excel.Application")
       End If
       Application.ScreenUpdating = False
       For i = 1 To .SelectedItems.Count
           Set mysheet = ShApp.Workbooks.Open(.SelectedItems(i))
                For x = 1 To mysheet.Sheets.Count
     With mysheet.Sheets(x)
                     .Columns(1).Insert
                End With
                n = n + 1
       Next x
       mysheet.Close True
       Next i
   End With
   If TF = True Then ShApp.Quit
   Set ShApp = Nothing
   MsgBox "处理完毕，共处理了" & n & "个excel文档。"
   Application.ScreenUpdating = True
End Sub

abc123281

新同学  需要上传附件

vai671

abc123281 发表于 2018-8-23 12:53
新同学  需要上传附件

好的，谢谢提醒