Question

我有一个宏，它从一个工作簿获取信息，并在另一个工作簿中。它工作正常，除非我去另一个工作簿并使用它移动项目粘贴在以前的信息而不是放在列表的底部。此外，它似乎没有识别我的范围，并从我的范围以下带来信息。我现在正在将这个宏添加到我需要信息的每个工作簿中，如果这会产生影响。

Sub Copy_With_AutoFilter()

Dim sName As String
Dim My_Range As Range
Dim wsMASTER As Worksheet
Dim shtName As Worksheet
Dim CalcMode As Long
Dim ViewMode As Long
Dim FilterCriteria As String
Dim CCount As Long
Dim rng As Range
Dim wbTarget As Workbook
Dim wbSource As Workbook

'Unprotect Sheet
ActiveSheet.Unprotect

'Set filter range on ActiveSheet
Set My_Range = Range("A94:E119")

'Set the sheet
Set wbSource = ThisWorkbook
Set wsMASTER = wbSource.Worksheets("MASTER")

'Set the destination worksheet
Set wbTarget = Workbooks.Open("A:\Accounting\Manifest Project\Manifest\2014\" & _
                      "Completion Bonus\Summer Bonus.xlsx")

sName = wsMASTER.Range("A1").Value

On Error Resume Next
Set shtName = wbTarget.Worksheets(sName)
On Error GoTo 0

If shtName Is Nothing Then
    MsgBox "Sheet was not found in target workbook!"
    Exit Sub
End If


'Change ScreenUpdating, Calculation, EnableEvents, .....
With Application
   CalcMode = .Calculation
   .Calculation = xlCalculationManual
   .ScreenUpdating = False
   .EnableEvents = False
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False

'Firstly, remove the AutoFilter
My_Range.Parent.AutoFilterMode = False

'Filter and set the filter field and the filter criteria
My_Range.AutoFilter Field:=1, Criteria1:=">0"


'Copy the visible data and use PasteSpecial to paste to the shtName
With My_Range.Parent.AutoFilter.Range
    On Error Resume Next
    'Set rng to the visible cells in My_Range without the header row
    Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
              .SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not rng Is Nothing Then
        'Copy and paste the cells into shtName below the existing data
        rng.Copy
        With shtName.Range("A1" & LastRow(shtName) + 1)
           .PasteSpecial Paste:=8
           .PasteSpecial xlPasteValues
           .PasteSpecial xlPasteFormats
           Application.CutCopyMode = False
        End With
    End If
End With
'Protect workbook
wbSource.Protect

'Close AutoFilter
My_Range.Parent.AutoFilterMode = False

'Restore ScreenUpdating, Calculation, EnableEvents, ....
ActiveWindow.View = ViewMode
Application.Goto shtName.Range("A1")
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = CalcMode
End With
End Sub

Answer 1

所以这些是您粘贴的行：

    With shtName.Range("A1" & LastRow(shtName) + 1)
       .PasteSpecial Paste:=8
       .PasteSpecial xlPasteValues
       .PasteSpecial xlPasteFormats
       Application.CutCopyMode = False
    End With

应该（我认为）：

    With shtName.Range("A" & (LastRow(shtName) + 1))
       .PasteSpecial Paste:=8
       .PasteSpecial xlPasteValues
       .PasteSpecial xlPasteFormats
       Application.CutCopyMode = False
    End With

你告诉它粘贴在“A1”中。通过删除它，你将允许它在我相信你想要的单元格中过去。

合并工作簿宏不仅仅复制范围而不粘贴到列表末尾

1 个答案: