VBA在工作簿之间按值粘贴

我正在尝试将工作簿1的工作表（表1）复制到工作簿2的工作表（cSrcTabName）

以下内容不适用于“按值粘贴”

Set wbk = Workbooks.Open(DepFile)
wbk.Sheets("Table1").Range("A1:BF200000").Copy
ThisWorkbook.Sheets(cSrcTabName).Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
wbk.Close
Set wbk = Nothing

注: cSrcTabName=常量

工作表（表1）顶部的几行合并了列和徽标。这需要在复制时取消合并otb

请帮我更正上面的代码

---

tnx.

看起来您需要将工作表名称置于“”，请更改此项：

ThisWorkbook.Sheets(cSrcTabName).Range("A1").PasteSpecial xlPasteValues

为此：

ThisWorkbook.Sheets("cSrcTabName").Range("A1").PasteSpecial xlPasteValues

试试这个：

Sub ExamplePasteSpecial()
Dim ws As Worksheet, wb As Workbook
Set ws = ActiveSheet
Set wb = Workbooks.Add(xlWBATWorksheet)
ws.Range("A1:G10").Copy
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub

---

它工作得非常完美。

工作簿2引用了工作簿1的目录。通过引用路径，wrkbook将加载paste special并忽略所有空列

Option Explicit

Sub csvFileImport()

Const cSrcTabName = "SrcSheet"  'Worksheet Name of destination workbook
Const cFileLocWS = "Master"   'Worksheet name that contains File location information
Const cFileName = "FileDirectory"   'Range name for FQDN filename
Const cTimestamp = "FileTimeStamp"   'Range name for timestamp of load process
Const cStatus = "Status"
Const cFirstVal = "Emp Name"   'First Column Heanding value


Dim vLCRWB As Workbook   'Destination Workbook
Dim vSrcWB As Workbook   'Source data workbook
Dim vSrcFileName As String   'Source data workbook FQDN filename
Dim vRowCount, vColCount, vLoopCount   'Loop counters

'
'*******************************************************************
'


'Application settings
Application.ScreenUpdating = False
Application.StatusBar = "Loading source file....."



'Delete the  worksheet if exists in destination workbook

Application.DisplayAlerts = False
On Error Resume Next
    Sheets(cSrcTabName).Delete
Application.DisplayAlerts = True


'Retrieve FQDN filename
vSrcFileName = Sheets(cFileLocWS).Range(cFileName).Value

'Check if file exists
If Not (Dir(vSrcFileName) > "") Then
    Sheets(cFileLocWS).Range(cTimestamp).Value = Now()
    Sheets(cFileLocWS).Range(cTimestamp).NumberFormat = "DD-MMM-YYYY HH:MM:SS"
    Sheets(cFileLocWS).Range(cStatus).Font.Color = vbRed
    Sheets(cFileLocWS).Range(cStatus).Value = "File Not Found"
    Application.StatusBar = "File Not Found!!!"
    Application.ScreenUpdating = True
    Exit Sub 'Exit if file does not exists
End If



'File Exists Create Worksheet
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = cSrcTabName  'Add worksheet to the end of the workbook



'Open source file workbook
Set vLCRWB = ActiveWorkbook
Set vSrcWB = Workbooks.Open(vSrcFileName)

If vSrcWB.Sheets.Count > 1 Then
    'More than 1 worksheet found....
    '  what to do!!!!!!!!

End If



' Select and Copy the data across from the data source file to destination workbook
'  Ref by worksheet name or number???
vSrcWB.Sheets(1).Activate

With ActiveWindow
    .ScrollRow = 1
    .ScrollColumn = 1
    Call Cells(rowIndex:=.ScrollRow, ColumnIndex:=.ScrollColumn).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    vLCRWB.Sheets(cSrcTabName).Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With



' Close data source workbook
Application.DisplayAlerts = False
vSrcWB.Close False
Application.DisplayAlerts = True
vLCRWB.Activate


' Clean up formatting
' - remove blank column
' - remove blank rows
'  File Layout Assumptions :-
'  * Header Row is copied across to Repo worksheet as well
'  * "Emp Name" Column is the first cell that has data
'  * Emp Name is the first Column with Data
vRowCount = vLCRWB.Sheets(cSrcTabName).Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
vColCount = vLCRWB.Sheets(cSrcTabName).Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column

'Delete blank Columns
vLoopCount = 1
Do While vLoopCount <= vColCount
    If WorksheetFunction.CountA(Sheets(cSrcTabName).Columns(vLoopCount)) > 0 Then
        vLoopCount = vLoopCount + 1
    Else
        Sheets(cSrcTabName).Columns(vLoopCount).Delete
        vColCount = vColCount - 1
    End If
Loop

'Delete blank Rows
vLoopCount = 1
Do While vLoopCount <= vRowCount
    If WorksheetFunction.CountA(Sheets(cSrcTabName).Rows(vLoopCount)) > 0 Then
        vLoopCount = vLoopCount + 1
    Else
        Sheets(cSrcTabName).Rows(vLoopCount).Delete
        vRowCount = vRowCount - 1
    End If
Loop


'Remove Rows with no Emp Name Number; Assume Column A is Emp Name after clean up
vRowCount = vLCRWB.Sheets(cSrcTabName).Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row

If Trim(Sheets(cSrcTabName).Cells(1, 1).Value) = cFirstVal Then
    vLoopCount = 1
    Do While vLoopCount <= vRowCount
        If Sheets(cSrcTabName).Cells(vLoopCount, 1).Value = "" Then
            Sheets(cSrcTabName).Rows(vLoopCount).Delete
            vRowCount = vRowCount - 1
        Else
            vLoopCount = vLoopCount + 1
        End If
    Loop
End If



'Format Output
Sheets(cSrcTabName).UsedRange.Columns.AutoFit
Call fSetPageLayout(cSrcTabName)


'App Settings - Complete
Sheets(cFileLocWS).Range(cTimestamp).Value = Now()
Sheets(cFileLocWS).Range(cTimestamp).NumberFormat = "DD-MMM-YYYY HH:MM:SS"
Sheets(cFileLocWS).Range(cStatus).Font.Color = vbGreen
Sheets(cFileLocWS).Range(cStatus).Value = "Success!"
Application.StatusBar = "source Sucessfully Imported!!!"
Application.ScreenUpdating = True


End Sub

选项显式
子csvFileImport（）
Const cSrcTabName=“SrcSheet”'目标工作簿的工作表名称
Const cFileLocWS=“Master”包含文件位置信息的工作表名称
FQDN文件名的Const cFileName=“FileDirectory”'范围名称
Const cTimestamp=“FileTimeStamp”'加载进程时间戳的范围名称
Const cStatus=“状态”
Const cFirstVal=“Emp Name”'第一列终止值
Dim vLCRWB作为工作簿的目标工作簿
Dim vSrcWB作为工作簿的源数据工作簿
Dim vSrcFileName作为字符串的源数据工作簿FQDN文件名
Dim vRowCount、vColCount、VLOOPCUNT循环计数器
'
'*******************************************************************
'
'应用程序设置
Application.ScreenUpdating=False
Application.StatusBar=“正在加载源文件…”
'如果目标工作簿中存在工作表，则删除该工作表
Application.DisplayAlerts=False
出错时继续下一步
工作表（cSrcTabName）。删除
Application.DisplayAlerts=True
'检索FQDN文件名
vSrcFileName=Sheets（cFileLocWS）.Range（cFileName）.Value
'检查文件是否存在
如果不是（Dir（vSrcFileName）>“”），则
图纸（cFileLocWS）.Range（cTimestamp）.Value=Now（）
图纸（cFileLocWS）.范围（cTimestamp）.编号格式=“DD-MMM-YYYY HH:MM:SS”
工作表（cFileLocWS）.Range（cStatus）.Font.Color=vbRed
工作表（cFileLocWS）.Range（cStatus）.Value=“未找到文件”
Application.StatusBar=“找不到文件！！！”
Application.ScreenUpdating=True
Exit Sub“如果文件不存在，则退出
如果结束
'文件已存在，请创建工作表
Worksheets.Add（之后：=Sheets（Sheets.Count））.Name=cSrcTabName“将工作表添加到工作簿末尾
'开源文件工作簿
设置vLCRWB=ActiveWorkbook
设置vSrcWB=Workbooks.Open（vSrcFileName）
如果vSrcWB.Sheets.Count>1，则
'找到多个工作表。。。。
‘怎么办!!!!!!!!!!!!!!!！！！！！！！！
如果结束
'选择数据并将其从数据源文件复制到目标工作簿
'按工作表名称或编号引用？？？
vSrcWB.Sheets（1）.激活
使用ActiveWindow
.ScrollRow=1
.ScrollColumn=1
调用单元格（rowIndex:=.ScrollRow，ColumnIndex:=.ScrollColumn）。选择
范围（选择，ActiveCell.SpecialCells（xlLastCell））。选择
选择，复制
vLCRWB.Sheets（cSrcTabName）.Cells（1，1）.PasteSpecial粘贴：=xlPasteValues，操作：=xlNone，SkipBlanks:=False，转置：=False
以
'关闭数据源工作簿
Application.DisplayAlerts=False
vSrcWB.Close错误
Application.DisplayAlerts=True
激活vLCRWB
'清除格式设置
“-删除空白列
“-删除空行
'文件布局假设：-
“*标题行也被复制到回购工作表中
“*”Emp Name“列是第一个包含数据的单元格
'*Emp名称是包含数据的第一列
vRowCount=vLCRWB.Sheets（cSrcTabName）.Cells（1,1）.SpecialCells（xlCellTypeLastCell）.Row
vColCount=vLCRWB.Sheets（cSrcTabName）.Cells（1,1）.SpecialCells（xlCellTypeLastCell）.Column
'删除空白列
vLoopCount=1
那么，当Vloop计数为0时执行此操作
vLoopCount=vLoopCount+1
其他的
工作表（cSrcTabName）.列（vLoopCount）.删除
vColCount=vColCount-1
如果结束
环
'删除空行
vLoopCount=1
那么，当Vloop计数为0时执行此操作
vLoopCount=vLoopCount+1
其他的
工作表（cSrcTabName）.行（vLoopCount）.删除
vRowCount=vRowCount-1
如果结束
环
'删除没有Emp名称编号的行；假设A列是清理后的Emp名称
vRowCount=vLCRWB.Sheets（cSrcTabName）.Cells（1,1）.SpecialCells（xlCellTypeLastCell）.Row
如果Trim（Sheets（cSrcTabName）.Cells（1，1）.Value）=cFirstVal，则
vLoopCount=1
当vLoopCount cSrcTabName是一个常量时，请执行此操作。忘了提及，源文件有合并的列，顶部有几个带有徽标的行（可以忽略）。在转换时，我们需要解散或删除空白列。这些附加信息应该被编辑到您的问题中。请陈述您的问题是什么或错误是什么。总是以一个问题来结束你的问题。（和问号“”）我看不到复制到目的地的代码。工作簿是空的。在没有合并列的其他工作表中，同样的代码也适用于我。我想你指的是单元格内容而不是“代码”。没错。你说得对。这就是代码无法复制您提到的合并列的地方；尝试
wbk.Sheets（“表1”）.Range（“A1:BF200000”）.unMerge
或
wbk.Sheets（“表1”）.Range（“A1:BF200000”）.MergeArea.unMerge
否。这对我不起作用。假设将源文件中的列（I-L）合并为一个单元格值，如名称。在这种情况下，它失败了。