kalmir01
09-03-2013, 03:51 AM
Hello,
I've been having trouble making the below procedure work automatically by just opening all the workbooks I need:
Sub copythenpasteworksheet()
'put active cell in worksheet to be copied
Range("B14:ak14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'paste in report
Windows("cgfd report august 2013 rev1.xlsm").Activate
Sheets("paste raw here").Select
Range("B13").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End sub
Here's a sample code I've modified but couldn't get it working:
Sub WBLoop()
Dim wbk As Workbook, rngToCopy As Range, rngToPaste As Range, sheetname As String, copyrange As Range
sheetname = "CGFD"
Set copyrange = Range("b14:ak14")
With Worksheets("paste raw here")
For Each wbk In Workbooks
'loop through the Open workbooks
If wbk.Name <> ThisWorkbook.Name Then
'exclude this workbook from the Loop
Set rngToPaste = .Range("b13").End(xlDown).Offset(1, 0)
'set the target For the paste
Set rngToCopy = wbk.Sheets(sheetname).Range(copyrange, copyrange.End(xlDown)) 'vba displays error message here
'set the range To be copied
rngToCopy.Copy Destination:=rngToPaste
'do the copying
End If
Next
End With
End Sub
Can you help in correcting the above code? Any help would be much appreciated. Thank you.
kalmir01
I've been having trouble making the below procedure work automatically by just opening all the workbooks I need:
Sub copythenpasteworksheet()
'put active cell in worksheet to be copied
Range("B14:ak14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'paste in report
Windows("cgfd report august 2013 rev1.xlsm").Activate
Sheets("paste raw here").Select
Range("B13").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End sub
Here's a sample code I've modified but couldn't get it working:
Sub WBLoop()
Dim wbk As Workbook, rngToCopy As Range, rngToPaste As Range, sheetname As String, copyrange As Range
sheetname = "CGFD"
Set copyrange = Range("b14:ak14")
With Worksheets("paste raw here")
For Each wbk In Workbooks
'loop through the Open workbooks
If wbk.Name <> ThisWorkbook.Name Then
'exclude this workbook from the Loop
Set rngToPaste = .Range("b13").End(xlDown).Offset(1, 0)
'set the target For the paste
Set rngToCopy = wbk.Sheets(sheetname).Range(copyrange, copyrange.End(xlDown)) 'vba displays error message here
'set the range To be copied
rngToCopy.Copy Destination:=rngToPaste
'do the copying
End If
Next
End With
End Sub
Can you help in correcting the above code? Any help would be much appreciated. Thank you.
kalmir01