Copy & Paste Macro optimize
 

Hi..

Thanks for all your help....i have this macro ....


Sub Macro1(name As String)
Workbooks.Open Filename:=name
Range("G7").Select
Selection.Copy
Windows("target.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(name).Activate
Range("G8").Select
Selection.Copy
Windows("target.xls").Activate
ActiveCell.Next.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(name).Activate
Range("G10").Select
Selection.Copy
Windows("target.xls").Activate
ActiveCell.Next.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(name).Activate
Range("F2").Select
Selection.Copy
Windows("target.xls").Activate
ActiveCell.Next.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(rowOffset:=1, columnOffset:=-3).Activate
Workbooks(name).Close SaveChanges:=False
End Sub

Sub Macro2()
Macro1 "Office_1.xls"
Macro1 "Office_2.xls"
..
..
..
End Sub

The paste range in "Target" is "C3:C6"...
The "Office*.xls" incoming in outlook mail attachments.. can a excel macro
extract it?

Thanks for your help

Copy & Paste Macro optimize
 

Try:

Sub Temp ()
Dim rngTarget As Range
Dim i As Integer

Set rngTarget = ActiveSheet.Cells

For i = 1 to 4 ' Assuming you are importing from 4 workbooks
Workbooks.Open "Office_" & i & ".xls"
RngTarget.Cells(i+2,"C").Value = ActiveSheet.Cells(7,"G").Value
RngTarget.Cells(i+2,"D").Value = ActiveSheet.Cells(8,"G").Value
RngTarget.Cells(i+2,"E").Value = ActiveSheet.Cells(10,"G").Value
RngTarget.Cells(i+2,"F").Value = ActiveSheet.Cells(2,"F").Value
ActiveWorkbook.Close False
Next i
End Sub

I hope I understood what you are doing correctly, if not then hopefully there's enough to work on here. Unfortunately this doesn't extract the files directly form outlook - you would still have to save them onto your HD or network, but I'm sure there is a way to get around this (I just don't know it!)

DN

"Andres" wrote:

Hi..

Thanks for all your help....i have this macro ....


Sub Macro1(name As String)
Workbooks.Open Filename:=name
Range("G7").Select
Selection.Copy
Windows("target.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(name).Activate
Range("G8").Select
Selection.Copy
Windows("target.xls").Activate
ActiveCell.Next.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(name).Activate
Range("G10").Select
Selection.Copy
Windows("target.xls").Activate
ActiveCell.Next.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(name).Activate
Range("F2").Select
Selection.Copy
Windows("target.xls").Activate
ActiveCell.Next.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(rowOffset:=1, columnOffset:=-3).Activate
Workbooks(name).Close SaveChanges:=False
End Sub

Sub Macro2()
Macro1 "Office_1.xls"
Macro1 "Office_2.xls"
..
..
..
End Sub

The paste range in "Target" is "C3:C6"...
The "Office*.xls" incoming in outlook mail attachments.. can a excel macro
extract it?

Thanks for your help

Copy & Paste Macro optimize
 

HI halfAce.. Thanx for your help.!!!!

The "name" is a file for each office "South_Office.xls
North_Office.xls, ...up to 8 files), the target range is "C3:G3"... an
paste data in one row :

"Target.xls"

-A---B-----------------C--------D--------E--------G-
01--South_Office----"G7"-----"G8"----"G10"---"F2"
01--North_Office----"G7"-----"G8"----"G10"---"F2"
01--Central_Office--"G7"-----"G8"----"G10"---"F2"