Help neeeded with simplifying this excel code.

[J_J]

Hi,

The below code intends to read data from 2 picked excel *.xlt files, pastes
them on the target file one after the other.
But the problem is that, although it worked without any errors on Win98
Office2K, I am getting complaint messages now. Especially with the repeted

Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros Which:=xlAutoOpen

lines...
If I eliminate them it doesn't work at all.
How can I close the read workbooks (after all data is read) with the
filenames beeing as varibles (strFileName1, strFileName2) and locations that
may vary?

'-------------------------
Sub Macro1()
'
' Macro1 Macro
'
'Dim strFileName1 As String
'Dim strFileName2 As String

strFileName1 = Application.GetOpenFilename("Excel Templates (*.xlt),
*.xlt")
If strFileName1 = "" Then Exit Sub
Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros
Which:=xlAutoOpen

Application.Visible = False

Worksheets("Sheet13").Activate
Range("C21:C30").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet1").Activate
Range("B1:B10").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet7").Activate
Range("G5:G19").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet1").Activate
Range("B14:B28").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet5").Activate
Range("G5:G12").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet1").Activate
Range("B31:B38").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet6").Activate
Range("G5:G11").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet1").Activate
Range("B41:B47").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet8").Activate
Range("G5:G13").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet1").Activate
Range("B50:B58").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet2").Activate
Range("G5:G9").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet1").Activate
Range("B61:B65").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet11").Activate
Range("G5:G8").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet1").Activate
Range("B68:B71").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet3").Activate
Range("G5:G8").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet1").Activate
Range("B74:B77").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName1, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet4").Activate
Range("G5:G7").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet1").Activate
Range("B80:B82").Select
ActiveSheet.Paste , True

'Application.Visible = True

strFileName2 = Application.GetOpenFilename("Excel Templates (*.xlt),
*.xlt")
If strFileName2 = "" Then Exit Sub
Workbooks.Open(strFileName2, Editable:=True).RunAutoMacros
Which:=xlAutoOpen

Application.Visible = False

Worksheets("Sheet13").Activate
Range("C21:C30").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet2").Activate
Range("B1:B10").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName2, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet7").Activate
Range("G5:G19").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet2").Activate
Range("B14:B28").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName2, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet5").Activate
Range("G5:G12").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet2").Activate
Range("B31:B38").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName2, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet6").Activate
Range("G5:G11").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet2").Activate
Range("B41:B47").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName2, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet8").Activate
Range("G5:G13").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet2").Activate
Range("B50:B58").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName2, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet2").Activate
Range("G5:G9").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet2").Activate
Range("B61:B65").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName2, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet11").Activate
Range("G5:G8").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet2").Activate
Range("B68:B71").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName2, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet3").Activate
Range("G5:G8").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet2").Activate
Range("B74:B77").Select
ActiveSheet.Paste , True

Workbooks.Open(strFileName2, Editable:=True).RunAutoMacros
Which:=xlAutoOpen
Worksheets("Sheet4").Activate
Range("G5:G7").Select
Selection.Copy
Windows("AnalizR4.xls").Activate
Worksheets("Sheet2").Activate
Range("B80:B82").Select
ActiveSheet.Paste , True

' Finished copying

Application.Visible = True

Application.CutCopyMode = False

Windows("AnalizR4.xls").Activate
Worksheets("Sheet3").Activate
Worksheets("Sheet3").Range("A12") = strFileName1
Worksheets("Sheet3").Range("B12") = strFileName2
End Sub
'-----------------------
'--------------------

TIA
J_J

 

[JE McGimpsey]

One way:

You almost never need to select/activate ranges in order to work with
them. Using the range objects directly makes your code smaller, faster,
and IMO easier to maintain.

Here's the way I might approach things. It's a partial solution, but you
should get the idea:

Public Sub Macro1()
Dim strFileName1 As String
Dim strFileName2 As String
Dim wsDest As Worksheet

strFileName1 = Application.GetOpenFilename()
If strFileName1 = "" Then Exit Sub
Application.Visible = False
Set wsDest = Workbooks("AnalizR4.xls").Worksheets("Sheet1")
With Workbooks.Open(strFileName1, Editable:=True)
.RunAutoMacros Which:=xlAutoOpen
.Worksheets("Sheet13").Range("C21:C30").Copy _
Destination:=wsDest.Range("B1")
.Worksheets("Sheet7").Range("G5:G19").Copy _
Destination:=wsDest.Range("B14")
.Worksheets("Sheet5").Range("G5").Copy _
Destination:=wsDest.Range("B31")
.Worksheets("Sheet6").Range("G5:G11").Copy _
Destination:=wsDest.Range("B41")
.Worksheets("Sheet8").Range("G5:G13").Copy _
Destination:=wsDest.Range("B50")
.Worksheets("Sheet2").Range("G5:G9").Copy _
Destination:=wsDest.Range("B61")

 

[J_J]

Thank you very much JE McGimpsey,
Apart from your solution suggestion, I also received another suggestion on
NG "microsoft.public.excel.programming" to the same Q., that doesn't make
use of copy/paste but just "reads" the ranges and assigns the values to the
destination cells on the target book. Here is the final version of the code:

'-----------------------------
Sub Macro1()

Dim strFileName1, strFileName2 As String
Dim wb1, wb2 As Workbook

strFileName1 = Application.GetOpenFilename("Excel Templates (*.xlt), *.xlt")
If strFileName1 = "" Then Exit Sub
Set wb1 = Workbooks.Open(strFileName1)
Application.Visible = False

ThisWorkbook.Worksheets("Sheet1").Range("B1:B10").Value =
wb1.Worksheets("Sheet13").Range("C21:C30").Value
' similar code lines with other Sheet range cells
ThisWorkbook.Worksheets("Sheet1").Range("B80:B82").Value =
wb1.Worksheets("Sheet4").Range("G5:G7").Value

wb1.Close False
Set wb1 = Nothing
Application.Visible = True

strFileName2 = Application.GetOpenFilename("Excel Templates (*.xlt),
*.xlt")
If strFileName2 = "" Then Exit Sub
Set wb2 = Workbooks.Open(strFileName2)
Application.Visible = False

ThisWorkbook.Worksheets("Sheet2").Range("B1:B10").Value =
wb2.Worksheets("Sheet13").Range("C21:C30").Value
' similar code lines with other Sheet range cells
ThisWorkbook.Worksheets("Sheet2").Range("B80:B82").Value =
wb2.Worksheets("Sheet4").Range("G5:G7").Value

wb2.Close False
Set wb2 = Nothing
Application.Visible = True

Worksheets("Sheet3").Activate
Worksheets("Sheet3").Range("A12") = strFileName1
Worksheets("Sheet3").Range("B12") = strFileName2
End Sub
'-----------------------------------------------
Sincerely
J_J

 

[JE McGimpsey]

Yup, if you're not interested in copying formatting, assigning values is
a better solution.

Couple of notes:

When you put 2 variables on a line, you need to include the type for
each of them. Using

Dim strFileName1, strFileName2 As String
Dim wb1, wb2 As Workbook

declares strFileName2 as a String, wb2 as a Workbook, but strFileName1
and wb1 as Variants. Either put each on one line, or use

Dim strFileName1 As String, strFileName2 As String
Dim wb1 As Workbook, wb2 As Workbook

(OTOH, you could just declare

Dim strFileName As String
Dim wb As Workbook

and reuse the variables in each section.)

The solution you were given would be more efficient if you used a

With ThisWorkbook.Worksheets("Sheet1")
.Range("B1:B10").Value = wb1.Sheets("Sheet13").Range("C21:C30").Value
.Range("B80:B82").Value = wb1.Sheets("Sheet4").Range("G5:G7").Value
'...
End With

structure, so that ThisWorkbook and Worksheets("Sheet1") didn't have to
be evaluated each time...

In general the

Set wb1 = Nothing

is neither necessary nor desirable unless you really need those few
bytes (which it's apparent you don't, since you're using two object
variables where one would do). VBA more efficiently cleans up after
itself when the code execution ends.