将数据从一个Excel工作簿复制到另一个工作簿,同时保留格式

时间:2018-07-29 10:31:04

标签: excel vba excel-vba copy copy-paste

我是excel VBA的新手。我已经编写了VBA代码以选择任何Excel文件并将该文件的路径复制到单元格A1中。我试图使用该路径复制源文件Sheet7的内容,同时保留单元格格式,即粗体,边框,颜色等。

我的第一个错误出现在文件路径上。当前单元格 A1值 = C:\ Users \ Personal \ Documents \ Excel文件\ Dummy-Data-Copy.xlsx 。 当我尝试读取A1单元格的值时,VBA抛出一个错误“抱歉,我们找不到。是否可能将其移动,重命名或删除了?”并自动清除单元格A1的值。但是,当我直接在VBA脚本中给出相同的路径时,它可以工作!有人可以告诉我如何解决此问题吗?

我的第二个疑问是关于复制单元格格式。当我使用wksht.paste将复制的内容粘贴到Sheet2时,它只是粘贴所有单元格值而不进行格式化。但是,当我尝试使用PasteSpecial时,会发生以下错误-“应用程序定义或对象定义的错误”。有人可以帮我解决这个问题吗?

    Sub Button1_Click()
        ' define variables
        Dim lastRow As Long
        Dim myApp As Excel.Application
        Dim wbk As Workbook
        Dim wkSht As Object
        Dim filePath As Variant

    'on error statement
    On Error GoTo errHandler:

        ' Select file path
        Set myApp = CreateObject("Excel.application")
        Sheet2.Range("A1").Value = filePath
        Set wbk = myApp.Workbooks.Open(filePath)
        'Set wbk = myApp.Workbooks.Open("C:\Users\Personal\Documents\Excel files\Dummy-Data - Copy.xlsx")

    ' Copy contents
        Application.ScreenUpdating = False
        lastRow = wbk.Sheets(7).Range("A" & Rows.Count).End(xlUp).Row
        wbk.Sheets(7).Range("A2:Q" & lastRow).Copy
        myApp.DisplayAlerts = False
        wbk.Close
        myApp.Quit

    ' Paste contents
        Set wbk = Nothing
        Set myApp = Nothing
        Set wbk = ActiveWorkbook
        Set wkSht = wbk.Sheets("Sheet2")
        wkSht.Activate
        Range("A2").Select
        wkSht.Paste
        'wkSht.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False

        Application.ScreenUpdating = True
        Exit Sub

    'error block
errHandler:
            MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
            & Err.Number & vbCrLf & Err.Description & vbCrLf & _
            "Please follow instruction sheet"

        End Sub

1 个答案:

答案 0 :(得分:0)

  

我的第一个错误出现在文件路径中。当前单元格A1的值= C:\ Users \ Personal \ Documents \ Excel files \ Dummy-Data-Copy.xlsx。当我尝试读取A1单元格的值时,VBA抛出一个错误“抱歉,我们找不到。是否可能将其移动,重命名或删除了?”并自动清除单元格A1的值。

您没有将var的值设置为单元格的值,而是将单元格的值设置为空白var,从而擦除了单元格的值。它应该是filePath = Sheet2.Range("A1").Value(与上面的内容相反)。

  

当我使用wksht.paste将复制的内容粘贴到Sheet2时,它只是粘贴所有单元格值而不进行格式化。

您不只是在工作簿之间粘贴;您要在单独的应用程序实例中打开的工作簿之间进行粘贴。跨实例粘贴时,您会丢失诸如格式化之类的细节。无论如何,单独使用Excel.Application似乎完全没有必要。

Option Explicit

Sub Button1_Click()
    ' define variables
    Dim lastRow As Long
    Dim wbk As Workbook
    Dim filePath As Variant

    'on error statement
    On Error GoTo errHandler:

    ' Select file path
    filePath = Sheet2.Range("A1").Value
    Set wbk = Workbooks.Open(filePath)
    'Set wbk = Workbooks.Open("C:\Users\Personal\Documents\Excel files\Dummy-Data - Copy.xlsx")

' Copy contents & Paste contents
    Application.ScreenUpdating = False

    lastRow = wbk.Sheets(7).Range("A" & Rows.Count).End(xlUp).Row
    wbk.Sheets(7).Range("A2:Q" & lastRow).Copy _
        Destination:=Sheet2.Range("A2")

    'shouldn't have to disable alerts
    'Application.DisplayAlerts = False
    wbk.Close savechanges:=False
    'Application.DisplayAlerts = True
'
    Application.ScreenUpdating = True
    Exit Sub

'error block
errHandler:
    MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
        & Err.Number & vbCrLf & Err.Description & vbCrLf & _
        "Please follow instruction sheet"

End Sub

裸露的工作表代号引用应在ThisWorkbook中有效。