将多个工作簿中的数据复制到新工作表中，工作表名称与工作簿名称相同

时间：2013-12-04 17:02:54

标签： vba excel-vba excel

我需要将多个工作簿中的数据复制到一个工作簿中。我的工作表名称与每个工作簿的工作簿名称相同。所以我的工作表名称随工作簿一直在变化。我无法执行代码。 

           Private Sub btn_upload_Click()
          Const FOLDER As String = "C:\ECGCSplit\"
          On Error GoTo ErrorHandler
          Dim i As Integer i = 3
          Dim sheetName As String
          sheetName = Dir(FOLDER, vbDirectory)
          Do While Len(sheetName) > 0
          If Right$(sheetName, 4) = "xlsx" Or Right$(sheetName, 3) = "xls" Then
          Dim sheetName As String
          Set sheetName = Right(fileName, 4)...(I am getting error here)

          Dim currentWkbk As Excel.Workbook

          Set currentWkbk = Excel.Workbooks.Open(FOLDER & sheetName)

 Cells(i, 2) = fileName
 Cells(i, 3) = currentWkbk.Sheets(sheetName).Cells(5, 4).Value
 Cells(i, 4) = currentWkbk.Sheets(sheetName).Cells(11, 4).Value
 Cells(i, 5) = currentWkbk.Sheets(sheetName).Cells(15, 4).Value
 Cells(i, 6) = currentWkbk.Sheets(sheetName).Cells(19, 4).Value
 Cells(i, 7) = currentWkbk.Sheets(sheetName).Cells(22, 4).Value
 Cells(i, 8) = currentWkbk.Sheets(sheetName).Cells(26, 4).Value
 Cells(i, 9) = currentWkbk.Sheets(sheetName).Cells(30, 4).Value
 Cells(i, 10) = currentWkbk.Sheets(sheetName).Cells(34, 4).Value
 Cells(i, 11) = currentWkbk.Sheets(sheetName).Cells(39, 4).Value
 Cells(i, 12) = currentWkbk.Sheets(sheetName).Cells(44, 4).Value
 Cells(i, 13) = currentWkbk.Sheets(sheetName).Cells(49, 4).Value
 Cells(i, 14) = currentWkbk.Sheets(sheetName).Cells(54, 4).Value
 Cells(i, 15) = currentWkbk.Sheets(sheetName).Cells(60, 4).Value
 Cells(i, 16) = currentWkbk.Sheets(sheetName).Cells(67, 4).Value
 Cells(i, 17) = currentWkbk.Sheets(sheetName).Cells(71, 4).Value
 Cells(i, 18) = currentWkbk.Sheets(sheetName).Cells(77, 4).Value
 Cells(i, 19) = currentWkbk.Sheets(sheetName).Cells(80, 4).Value
 Cells(i, 20) = currentWkbk.Sheets(sheetName).Cells(90, 4).Value
 Cells(i, 21) = currentWkbk.Sheets(sheetName).Cells(98, 4).Value
 Cells(i, 22) = currentWkbk.Sheets(sheetName).Cells(104, 4).Value
 Cells(i, 23) = currentWkbk.Sheets(sheetName).Cells(108, 4).Value
 Cells(i, 24) = currentWkbk.Sheets(sheetName).Cells(111, 4).Value
 Cells(i, 25) = currentWkbk.Sheets(sheetName).Cells(115, 4).Value
 Cells(i, 26) = currentWkbk.Sheets(sheetName).Cells(119, 4).Value
 Cells(i, 27) = currentWkbk.Sheets(sheetName).Cells(128, 4).Value
 Cells(i, 28) = currentWkbk.Sheets(sheetName).Cells(135, 4).Value
 Cells(i, 29) = currentWkbk.Sheets(sheetName).Cells(140, 4).Value
 Cells(i, 30) = currentWkbk.Sheets(sheetName).Cells(147, 4).Value
 Cells(i, 31) = currentWkbk.Sheets(sheetName).Cells(154, 4).Value
 Cells(i, 32) = currentWkbk.Sheets(sheetName).Cells(162, 4).Value
 Cells(i, 33) = currentWkbk.Sheets(sheetName).Cells(166, 4).Value
 Cells(i, 34) = currentWkbk.Sheets(sheetName).Cells(169, 4).Value
 Cells(i, 35) = currentWkbk.Sheets(sheetName).Cells(172, 4).Value
 Cells(i, 36) = currentWkbk.Sheets(sheetName).Cells(182, 4).Value
 Cells(i, 37) = currentWkbk.Sheets(sheetName).Cells(188, 4).Value
 Cells(i, 38) = currentWkbk.Sheets(sheetName).Cells(193, 4).Value
 Cells(i, 39) = currentWkbk.Sheets(sheetName).Cells(199, 4).Value
 Cells(i, 40) = currentWkbk.Sheets(sheetName).Cells(210, 4).Value
 Cells(i, 41) = currentWkbk.Sheets(sheetName).Cells(215, 4).Value
 Cells(i, 42) = currentWkbk.Sheets(sheetName).Cells(222, 4).Value
 Cells(i, 43) = currentWkbk.Sheets(sheetName).Cells(225, 4).Value
 Cells(i, 44) = currentWkbk.Sheets(sheetName).Cells(229, 4).Value
 Cells(i, 45) = currentWkbk.Sheets(sheetName).Cells(232, 4).Value
 Cells(i, 46) = currentWkbk.Sheets(sheetName).Cells(236, 4).Value
 Cells(i, 47) = currentWkbk.Sheets(sheetName).Cells(239, 4).Value
 Cells(i, 48) = currentWkbk.Sheets(sheetName).Cells(248, 4).Value
 Cells(i, 49) = currentWkbk.Sheets(sheetName).Cells(253, 4).Value
 Cells(i, 50) = currentWkbk.Sheets(sheetName).Cells(258, 4).Value
 Cells(i, 51) = currentWkbk.Sheets(sheetName).Cells(265, 4).Value
 Cells(i, 52) = currentWkbk.Sheets(sheetName).Cells(269, 4).Value
 Cells(i, 53) = currentWkbk.Sheets(sheetName).Cells(272, 4).Value
 Cells(i, 54) = currentWkbk.Sheets(sheetName).Cells(279, 4).Value
 Cells(i, 55) = currentWkbk.Sheets(sheetName).Cells(283, 4).Value
 Cells(i, 56) = currentWkbk.Sheets(sheetName).Cells(286, 4).Value
       i = i + 1

 currentWkbk.Close

End If
sheetName = Dir
Loop
ProgramExit: Exit Sub 
ErrorHandler: MsgBox Err.Number & " - " & Err.Description 
Resume
 ProgramExit
 End Sub

1 个答案:

答案 0 :(得分：1)

Private Sub btn_upload_Click()
    Const FOLDER As String = "C:\ECGCSplit\"
    Dim i As Integer
    i = 3
    Dim fileName As String
    fileName = Dir(FOLDER, vbDirectory)
    Do While Len(fileName) > 0
        If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then
            Dim sheetName As String
            If Right$(fileName, 4) = "xlsx" Then
                sheetName = Mid(fileName, 1, InStr(fileName, ".xlsx") - 1)
            ElseIf Right$(fileName, 3) = "xls" Then
                sheetName = Mid(fileName, 1, InStr(fileName, ".xls") - 1)
            End If

            Dim currentWkbk As Excel.Workbook

            Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)

            Cells(i, 2) = fileName
            Cells(i, 3) = currentWkbk.Sheets(sheetName).Cells(5, 4).Value
            Cells(i, 4) = currentWkbk.Sheets(sheetName).Cells(11, 4).Value
            Cells(i, 5) = currentWkbk.Sheets(sheetName).Cells(15, 4).Value
            Cells(i, 6) = currentWkbk.Sheets(sheetName).Cells(19, 4).Value
            Cells(i, 7) = currentWkbk.Sheets(sheetName).Cells(22, 4).Value
            Cells(i, 8) = currentWkbk.Sheets(sheetName).Cells(26, 4).Value
            Cells(i, 9) = currentWkbk.Sheets(sheetName).Cells(30, 4).Value
            Cells(i, 10) = currentWkbk.Sheets(sheetName).Cells(34, 4).Value
            Cells(i, 11) = currentWkbk.Sheets(sheetName).Cells(39, 4).Value
            Cells(i, 12) = currentWkbk.Sheets(sheetName).Cells(44, 4).Value
            Cells(i, 13) = currentWkbk.Sheets(sheetName).Cells(49, 4).Value
            Cells(i, 14) = currentWkbk.Sheets(sheetName).Cells(54, 4).Value
            Cells(i, 15) = currentWkbk.Sheets(sheetName).Cells(60, 4).Value
            Cells(i, 16) = currentWkbk.Sheets(sheetName).Cells(67, 4).Value
            Cells(i, 17) = currentWkbk.Sheets(sheetName).Cells(71, 4).Value
            Cells(i, 18) = currentWkbk.Sheets(sheetName).Cells(77, 4).Value
            Cells(i, 19) = currentWkbk.Sheets(sheetName).Cells(80, 4).Value
            Cells(i, 20) = currentWkbk.Sheets(sheetName).Cells(90, 4).Value
            Cells(i, 21) = currentWkbk.Sheets(sheetName).Cells(98, 4).Value
            Cells(i, 22) = currentWkbk.Sheets(sheetName).Cells(104, 4).Value
            Cells(i, 23) = currentWkbk.Sheets(sheetName).Cells(108, 4).Value
            Cells(i, 24) = currentWkbk.Sheets(sheetName).Cells(111, 4).Value
            Cells(i, 25) = currentWkbk.Sheets(sheetName).Cells(115, 4).Value
            Cells(i, 26) = currentWkbk.Sheets(sheetName).Cells(119, 4).Value
            Cells(i, 27) = currentWkbk.Sheets(sheetName).Cells(128, 4).Value
            Cells(i, 28) = currentWkbk.Sheets(sheetName).Cells(135, 4).Value
            Cells(i, 29) = currentWkbk.Sheets(sheetName).Cells(140, 4).Value
            Cells(i, 30) = currentWkbk.Sheets(sheetName).Cells(147, 4).Value
            Cells(i, 31) = currentWkbk.Sheets(sheetName).Cells(154, 4).Value
            Cells(i, 32) = currentWkbk.Sheets(sheetName).Cells(162, 4).Value
            Cells(i, 33) = currentWkbk.Sheets(sheetName).Cells(166, 4).Value
            Cells(i, 34) = currentWkbk.Sheets(sheetName).Cells(169, 4).Value
            Cells(i, 35) = currentWkbk.Sheets(sheetName).Cells(172, 4).Value
            Cells(i, 36) = currentWkbk.Sheets(sheetName).Cells(182, 4).Value
            Cells(i, 37) = currentWkbk.Sheets(sheetName).Cells(188, 4).Value
            Cells(i, 38) = currentWkbk.Sheets(sheetName).Cells(193, 4).Value
            Cells(i, 39) = currentWkbk.Sheets(sheetName).Cells(199, 4).Value
            Cells(i, 40) = currentWkbk.Sheets(sheetName).Cells(210, 4).Value
            Cells(i, 41) = currentWkbk.Sheets(sheetName).Cells(215, 4).Value
            Cells(i, 42) = currentWkbk.Sheets(sheetName).Cells(222, 4).Value
            Cells(i, 43) = currentWkbk.Sheets(sheetName).Cells(225, 4).Value
            Cells(i, 44) = currentWkbk.Sheets(sheetName).Cells(229, 4).Value
            Cells(i, 45) = currentWkbk.Sheets(sheetName).Cells(232, 4).Value
            Cells(i, 46) = currentWkbk.Sheets(sheetName).Cells(236, 4).Value
            Cells(i, 47) = currentWkbk.Sheets(sheetName).Cells(239, 4).Value
            Cells(i, 48) = currentWkbk.Sheets(sheetName).Cells(248, 4).Value
            Cells(i, 49) = currentWkbk.Sheets(sheetName).Cells(253, 4).Value
            Cells(i, 50) = currentWkbk.Sheets(sheetName).Cells(258, 4).Value
            Cells(i, 51) = currentWkbk.Sheets(sheetName).Cells(265, 4).Value
            Cells(i, 52) = currentWkbk.Sheets(sheetName).Cells(269, 4).Value
            Cells(i, 53) = currentWkbk.Sheets(sheetName).Cells(272, 4).Value
            Cells(i, 54) = currentWkbk.Sheets(sheetName).Cells(279, 4).Value
            Cells(i, 55) = currentWkbk.Sheets(sheetName).Cells(283, 4).Value
            Cells(i, 56) = currentWkbk.Sheets(sheetName).Cells(286, 4).Value
            i = i + 1

            currentWkbk.Close
        End If
        fileName = Dir
    Loop
End Sub
相关问题
最新问题