Question

我正在尝试将workbook1的工作表（Table1）复制到workbook2的工作表（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）已合并顶部几行的列和徽标。这需要在复制时取消合并。

通过更正上述代码帮助我。

TNX。

Answer 1

看起来您需要将工作表名称放在＆＃34;＆＃34;，更改此内容：

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

到此：

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

Answer 2

试试这个：

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

它很完美。

Answer 3

Workbook 2引用了工作簿1的目录。通过引用该路径，工作簿加载了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

VBA-按工作簿之间的值粘贴

3 个答案: