Automatic Paste to different workbooks

[Guest]

I have a Macro for extracting price options from a large pricelist with
several sheets. The Macro always copies to a workbook "MachineQuote1". How
can I make the macro copy to any selected workbook? I am a novice at working
with VB and Macros. The code is currently:-

Range("A1").Select
Selection.AutoFilter
Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:="Y"
Range("A1:O22").Select
Selection.Copy
Windows("MachineQuote1").Activate
ActiveCell.Select
ActiveSheet.Paste
ActiveCell.Select
Windows("RembrandtPriceList2006+AMJMPrices-17May06.xls").Activate
Application.CutCopyMode = False
Selection.AutoFilter
ActiveCell.Select
Windows("MachineQuote1").Activate
End Sub

 

[WhytheQ]

What you've got so far looks to me like a recorded macro - if next time
you run it the filtered area is A1:O25 your macro is unfortunately only
going to copy area A1:O22!
Have a go with this:

If ActiveSheet.AutoFilterMode = True Then
Range("A1").AutoFilter
End If
Range("A1").AutoFilter Field:=1, Criteria1:="Y"

Dim rng As Range
Set rng = ActiveSheet.AutoFilter.Range
rng.copy

ChDrive "P"
ChDir "P:\Daily &Reports\"

Dim MyXlPathway As String
MyXlPathway = Application.GetOpenFilename("Excel Files (*.xls),
*.xls", 1, "Select the Excel file you wish to copy data into........")
Workbooks.Open MyXlPathway, , True
range("A1").paste


you might need to change a few little details (e.g drive and directory)
to suit your needs
Regards
J

 

[Don Guillett]

sub copytowk
Range("A1").AutoFilter Field:=1, Criteria1:="Y"
Range("A1:O22").Copy
workbooks("MachineQuote1.xls").sheets("yoursheet").range("a1")
End Sub

Or you can make a list of workbook names>right click sheet tab>view
code>insert this>double click on the cell with the name of the workbook.
Modify to suit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
If ActiveCell.Value = "" Then Exit Sub
workbookname = ActiveCell.Value
On Error GoTo OpenWorkbook
Windows(workbookname & ".xls").Activate
Exit Sub
OpenWorkbook:
Workbooks.Open(workbookname & ".xls").RunAutoMacros xlAutoOpen

With Workbooks("sourceworkbookname.xls").Sheets("sourcesheet")
Range("A1").AutoFilter Field:=1, Criteria1:=1
Range("A1:O22").Copy Workbooks(workbookname &
".xls").Sheets("sheet1").Range("a1")
..Range("a1").AutoFilter
End With

End Sub


sub copytowk
'mywb=target
Range("A1").AutoFilter Field:=1, Criteria1:="Y"
Range("A1:O22").Copy
workbooks("MachineQuote1.xls").sheets("yoursheet").range("a1")
End Sub

 

[Guest]

Hi J

Have looked at your post and tried to use the code. However the macro stops
when I get to: -

MyXlPathway = Application.GetOpenFilename("Excel Files (*.xls),
*.xls", 1, "Select the Excel file you wish to copy data into........")
Workbooks.Open MyXlPathway, , True
Range("A1").Paste

My original macro works well, the only thing I want to change is where to
paste the information. I preferably need it to go to any machine quoute I
have open and to the cell I select. Does this make any difference to your
suggestion?

Thanks for help so far
--
Thanks

Mannie G

What you've got so far looks to me like a recorded macro - if next time
you run it the filtered area is A1:O25 your macro is unfortunately only
going to copy area A1:O22!
Have a go with this:

If ActiveSheet.AutoFilterMode = True Then
Range("A1").AutoFilter
End If
Range("A1").AutoFilter Field:=1, Criteria1:="Y"

Dim rng As Range
Set rng = ActiveSheet.AutoFilter.Range
rng.copy

ChDrive "P"
ChDir "P:\Daily &Reports\"

Dim MyXlPathway As String
MyXlPathway = Application.GetOpenFilename("Excel Files (*.xls),
*.xls", 1, "Select the Excel file you wish to copy data into........")
Workbooks.Open MyXlPathway, , True
range("A1").paste


you might need to change a few little details (e.g drive and directory)
to suit your needs
Regards
J

 

[Guest]

Hello Don,

Have tried to understand your code information, not sure how to make this
work and where / how I should use it. The main thing I need to do differently
is to be able to select any quote workbook open it and paste into any cell
selected in column A

Thanks for information so far
--
Thanks

Mannie G

sub copytowk
Range("A1").AutoFilter Field:=1, Criteria1:="Y"
Range("A1:O22").Copy
workbooks("MachineQuote1.xls").sheets("yoursheet").range("a1")
End Sub

Or you can make a list of workbook names>right click sheet tab>view
code>insert this>double click on the cell with the name of the workbook.
Modify to suit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
If ActiveCell.Value = "" Then Exit Sub
workbookname = ActiveCell.Value
On Error GoTo OpenWorkbook
Windows(workbookname & ".xls").Activate
Exit Sub
OpenWorkbook:
Workbooks.Open(workbookname & ".xls").RunAutoMacros xlAutoOpen

With Workbooks("sourceworkbookname.xls").Sheets("sourcesheet")
Range("A1").AutoFilter Field:=1, Criteria1:=1
Range("A1:O22").Copy Workbooks(workbookname &
".xls").Sheets("sheet1").Range("a1")
..Range("a1").AutoFilter
End With

End Sub


sub copytowk
'mywb=target
Range("A1").AutoFilter Field:=1, Criteria1:="Y"
Range("A1:O22").Copy
workbooks("MachineQuote1.xls").sheets("yoursheet").range("a1")
End Sub