如何将Excel数据导入新工作簿?

时间:2016-05-31 20:14:47

标签: excel vba excel-vba

我正在尝试将多个excel文件合并到一个文件中。我能够正确地做到这一点,但我想放置数据的位置遇到了一个小问题。

我希望我的数据在标题行下的单元格A2处开始(粘贴),但由于我的工作表被格式化为具有命名范围的表格,因此我的数据被粘贴在该空白表格的最后一行的下方。这是我用来粘贴数据的代码。

Sub CombineFiles()

Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer

ThisWB = ActiveWorkbook.Name

path = "C:\MyFolder"

RowofCopySheet = 2

Application.EnableEvents = False
Application.ScreenUpdating = False

Set shtDest = ActiveWorkbook.Sheets("Import")
Range("A2").Select
Filename = Dir(path & "\*.xl??", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
    If Not Filename = ThisWB Then
        Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
        Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
        Set Dest = shtDest.Range("A" & shtDest.Cells(Rows.Count, 1).End(xlUp).Row + 1)
        CopyRng.Copy
        Dest.PasteSpecial xlPasteFormats
        Dest.PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False 'Clear Clipboard
        Wkb.Close False
    End If

    Filename = Dir()
Loop
Sheets("Import").Select
Range("A1").Select
End Sub

我可以对表格中的代码或单元格内容进行任何更改以使其正常工作吗?谢谢你的帮助!

1 个答案:

答案 0 :(得分:0)

请根据您的要求更改范围后尝试此操作。它将从A2粘贴。使用剪贴板需要时间和资源,因此最好的方法是避免复制和粘贴,只需将值设置为您想要的值。虽然您已经提到在单独的工作簿之间需要数据传输但是仅提到基本问题的代码,所以这个代码片段在涉及到命名表的情况下传达了传输的基本概念。

Sub Normalize()
    Dim CopyFrom As Range

    Set CopyFrom = Sheets("Sheet2").Range("A2", [H30])
    Sheets("Sheet1").Range("A1").Resize(CopyFrom.Rows.Count).Value = CopyFrom.Value

End Sub