apologies for posting it again but...

J

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, but now with my new system WinXP+Office2003 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
 
G

Guest

there's no need to keep opening the workbook from which you're copying each
time....in the code below I have done most of what you need ... you just need
to repeat the two lines for copy/paste for the ranges that I didn't do

Option Explicit

Sub Macro1()

Dim strFileName1 As String
Dim wb1 As Workbook

strFileName1 = Application.GetOpenFilename("Excel Templates
(*.xlt),*.xlt")
If strFileName1 = "" Then Exit Sub

Set wb1 = Workbooks.Open(strFileName1)

''' Application.Visible = False

wb1.Worksheets("Sheet13").Range("C21:C30").Copy
ThisWorkbook.Worksheets("Sheet1").Range("B1:B10").PasteSpecial xlAll

wb1.Worksheets("Sheet7").Range("G5:G19").Copy
ThisWorkbook.Worksheets("Sheet1").Range("B14:B28").PasteSpecial xlAll

wb1.Worksheets("Sheet5").Range("G5:G12").Copy
ThisWorkbook.Worksheets("Sheet1").Range("B31:B38").PasteSpecial xlAll

''' REPEAT THESE TWO LINES FOR EVERY RANGE '''

wb1.Worksheets("Sheet5").Range("G5:G12").Copy
ThisWorkbook.Worksheets("Sheet1").Range("B31:B38").PasteSpecial xlAll

''' etc etc

wb1.Close False
Set wb1 = Nothing
strFileName1 = ""

'Application.Visible = True

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

''' Application.Visible = False

''' REPEAT THESE TWO LINES FOR EVERY RANGE '''

wb1.Worksheets("Sheet13").Range("C21:C30").Copy
ThisWorkbook.Worksheets("Sheet2").Range("B1:B10").PasteSpecial xlAll

''' etc etc
''' example
wb1.Worksheets("Sheet7").Range("G5:G19").Copy
ThisWorkbook.Worksheets("Sheet2").Range("B14:B28").PasteSpecial xlAll




' Finished copying
Application.CutCopyMode = False

wb1.Close False
Set wb1 = Nothing

Application.Visible = True



Worksheets("Sheet3").Activate
Worksheets("Sheet3").Range("A12") = strFileName1
Worksheets("Sheet3").Range("B12") = strFileName1

End Sub

NOTE: Copy/paste is BAD - so use it if you need the formats etc etc
IF you only want the values then each pair can be made into a single line,
and this will work much faster...

example
these two lines
wb1.Worksheets("Sheet13").Range("C21:C30").Copy
ThisWorkbook.Worksheets("Sheet1").Range("B1:B10").PasteSpecial xlAll
become
ThisWorkbook.Worksheets("Sheet1").Range("B14:B28").value = _
wb1.Worksheets("Sheet7").Range("G5:G19").value

HTH
Patrick Molloy
Microsoft Excel MVP
 
J

J_J

Thank you Patrick,
I appreciate your help...I'll try your suggestions and get back here when
done.
Sincerely
J_J
 
J

J_J

Hi Patrick,
Thank you so much...
Here is the working code with your solution alternative
'-----------------------------
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
'-----------------------------------------------
 
P

Patrick Molloy

1) you don't need wb2 or strFilename2 as you don't need to have them both
open
2) your DIM statements are wrong. You have:
Dim strFileName1, strFileName2 As String
Dim wb1, wb2 As Workbook
This is the same as:
Dim strFileName1 AS VARIANT, strFileName2 As String
Dim wb1 AS VARIANT, wb2 As Workbook
-- if not explicitly dimensioned, then Variant is the default. Your code
looks like an old DOS BASIC ;)
they should be
Dim strFileName1 As String, strFileName2 As String
Dim wb1 As Workbook, wb2 As Workbook

regards
Patrick
 
J

J_J

Thank you very much Patrick,
Since you are the MS MVP, you should know the best...:)
But I am an old programmer from thouse old DOS days...:)
Just a newbee on Excel programming.
Regards
J_J
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help neeeded with simplifying this excel code. 3
Getting #REF error on copy/pasted cells with macro! 3
Filename Variable? 2
how to select cells dynamically in excel macro? 1
VBA Code runs out of memory - too much copy/paste? 0
Code Help 3
find specific data in row and select and copy entirerow 3
Excel Macro error 3

Top