I have a tricky copy and paste problem. I have an excel 2007 workbook, called Summary, with two sheets in it (sheet 1 and sheet 2). I have a list of the names of excel workbooks that reside given folder on my hard drive typed into Column A on Sheet 1. I开发者_开发知识库 am trying to open each of those workbooks, copy specific cells in each of those workbooks, and paste them into my Summary workbook, in sheet TWO. I've got them going perfectly onto Sheet 1, but can't seem to copy them to Sheet 2. Any help would be greatly appreciated!
Thank you,
Jonathan
Here is my code:
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
Keep track of your workbooks.
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
精彩评论