Question

我有一个棘手的复制和粘贴问题。我有一个名为Summary的excel 2007工作簿，里面有两张（表1和表2）。我有一个excel工作簿的名称列表，这些工作簿位于我的硬盘驱动器上的文件夹中，输入到工作表1的A列。我试图打开每个工作簿，复制每个工作簿中的特定单元格，然后将它们粘贴到我的工作簿中摘要工作簿，在表格TWO中。我让他们完美地进入表1，但似乎无法将它们复制到表2.任何帮助将不胜感激！

谢谢，

乔纳森

这是我的代码：

Sub CopyRoutine()
    Const SrcDir As String = "C:\filepath\"
    Dim SrcRg As Range
    Dim FileNameCell As Range
    Dim Counter As Integer
    Application.ScreenUpdating = False
    'Selecting the list of workbook names
    Set SrcRg = Range(Range("A2"), Range("A3").End(xlDown))
    On Error GoTo SomethingWrong
    For Each FileNameCell In SrcRg
        Counter = Counter + 1
        Application.StatusBar = "Doing workbook " & Counter & " of " & SrcRg.Cells.Count
        'Copying the selected cells
        Workbooks.Open SrcDir & FileNameCell.Value
        Sheets("Sheet1").Visible = True
        Sheets("Sheet1").Select
        Range("'Sheet1'!J4:K4").Copy
        Sheets("Sheet2").Select
        'Pasting the selected cells - but i cannot seem to move to sheet 2!
        FileNameCell.Offset(0, 5).PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False 'Clear Clipboard
        ActiveWorkbook.Close False
    Next
    Application.StatusBar = False
    Exit Sub
SomethingWrong:
    MsgBox "Could not process " & FileNameCell.Value
End Sub

Answer 1

跟踪您的工作簿。

Sub CopyRoutine()
    Const SrcDir As String = "C:\filepath\"
    Dim SrcRg As Range
    Dim FileNameCell As Range
    Dim Counter As Integer
    Dim SummaryWorkbook As Workbook       'added
    Dim SourceDataWorkbook As Workbook    'added
    Set SummaryWorkbook = ActiveWorkbook  'added
    Application.ScreenUpdating = False
    'Selecting the list of workbook names
    Set SrcRg = Range(Range("A2"), Range("A3").End(xlDown))
    On Error GoTo SomethingWrong
    For Each FileNameCell In SrcRg
        Counter = Counter + 1
        Application.StatusBar = "Doing workbook " & Counter & " of " & SrcRg.Cells.Count
        'Copying the selected cells
        Set SourceDataWorkbook = Workbooks.Open SrcDir & FileNameCell.Value
        Sheets("Sheet1").Visible = True
        Sheets("Sheet1").Select
        Range("'Sheet1'!J4:K4").Copy
        SummaryWorkbook.Sheets("Sheet2").Select  'goto correct workbook!
        'Pasting the selected cells - but i cannot seem to move to sheet 2!
        FileNameCell.Offset(0, 5).PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False 'Clear Clipboard
        SourceDataWorkbook.Close False   
    Next
    Application.StatusBar = False
    Exit Sub
SomethingWrong:
    MsgBox "Could not process " & FileNameCell.Value
End Sub

VBA粘贴到不同的工作簿，不同的工作表

1 个答案: