Macro to Copy 2 Wb Ranges into 3rd Wb. 
Author Message
 Macro to Copy 2 Wb Ranges into 3rd Wb.

Hi, XL97.

I need to combine ranges in 2 workbooks into a 3rd base workbook.

There are some 60 projects, each with 2 workbooks that require info transfer
to an updated "base" workbook.

Here is what I need to do 60 times.
3 separate workbooks, Book 1, Book 2, and Base3.

I need to copy the following ranges from Books 1 & 2 into Base 3.

[Book 1]Sheet1!A2:A46  to [Base 3]Sheet1!A2:A46.
[Book 1]Sheet1!B2:B46  to [Base 3]Sheet1!D2:D46.
[Book 1]Sheet1!C2:C46  to [Base 3]Sheet1!H2:H46.

[Book 2]Sheet1!A2:A46  to [Base 3]Sheet2!A2:A46.
[Book 2]Sheet1!A2:A46  to [Base 3]Sheet2!D2:D46.
[Book 2]Sheet1!A2:A46  to [Base 3]Sheet2!H2:H46.

The "Base 3" workbook is then saved under a separate name.

The process then needs to be repeated with the balance of project files and
the "Base3" workbook.

To do this copy/paste manually would take some time.

Is it feasible to create a macro and pause it to either:

     allow input into a message box of the file names from where the data is
to be copied from (given the cell reference ranges for all files will remain
constant, as will the Base 3 workbook name and cells. Only the 2 workbooks
from where the data is being copied from will change),

or

    allow input into a message box of the range to be copied (given that
this option would occur 6 times each time the macro is invoked)?

Any help would be greatly appreciated.

TIA

Bob
Maitland   Australia



Thu, 04 Oct 2001 03:00:00 GMT  
 Macro to Copy 2 Wb Ranges into 3rd Wb.
Hi Bob,

Here is an approach I have used in simular circumstances:

Use a 4th workbook, put data in sheet1:

A1:A60 The names you want for your base files
B1:B60 The names of the book1 files
C1:C60 The names of the book2 files

Now select A1:A60 and run this macro:

Sub Copy2wbRangesInto3wb()
Dim oBook1 As Workbook
Dim oBook2 As Workbook
Dim c As Range

For Each c In Selection

    'open the workbooks in column B and C
    Set oBook1 = Workbooks.Open(c.Offset(0, 1).Value)
    Set oBook2 = Workbooks.Open(c.Offset(0, 2).Value)

    'open new workbook and put the relevant values in the
    'ranges you want.
    With Workbooks.Add
    .Sheets("Sheet1").Range("A2:A46") =
oBook1.Sheets("Sheets1").Range("A2:A46")
    .Sheets("Sheet1").Range("B2:B46") =
oBook1.Sheets("Sheets1").Range("B2:B46")
    .Sheets("Sheet1").Range("H2:H46") =
oBook1.Sheets("Sheets1").Range("C2:C46")
    .Sheets("Sheet2").Range("A2:A46") =
oBook2.Sheets("Sheets1").Range("A2:A46")
    .Sheets("Sheet2").Range("D2:D46") =
oBook2.Sheets("Sheets1").Range("A2:A46")
    .Sheets("Sheet2").Range("H2:H46") =
oBook2.Sheets("Sheets1").Range("A2:A46")

    'close the newly created workbook with the name of the selected cel
    .Close True, c.Value
    End With

    'close the workbooks and don't save the changes
    sbook1.Close False
    sbook2.Close False
Next c
End Sub

Regards
Marco Schreuder

Quote:

>Hi, XL97.

>I need to combine ranges in 2 workbooks into a 3rd base workbook.

>There are some 60 projects, each with 2 workbooks that require info
transfer
>to an updated "base" workbook.

>Here is what I need to do 60 times.
>3 separate workbooks, Book 1, Book 2, and Base3.

>I need to copy the following ranges from Books 1 & 2 into Base 3.

>[Book 1]Sheet1!A2:A46  to [Base 3]Sheet1!A2:A46.
>[Book 1]Sheet1!B2:B46  to [Base 3]Sheet1!D2:D46.
>[Book 1]Sheet1!C2:C46  to [Base 3]Sheet1!H2:H46.

>[Book 2]Sheet1!A2:A46  to [Base 3]Sheet2!A2:A46.
>[Book 2]Sheet1!A2:A46  to [Base 3]Sheet2!D2:D46.
>[Book 2]Sheet1!A2:A46  to [Base 3]Sheet2!H2:H46.

>The "Base 3" workbook is then saved under a separate name.

>The process then needs to be repeated with the balance of project files and
>the "Base3" workbook.

>To do this copy/paste manually would take some time.

>Is it feasible to create a macro and pause it to either:

>     allow input into a message box of the file names from where the data
is
>to be copied from (given the cell reference ranges for all files will
remain
>constant, as will the Base 3 workbook name and cells. Only the 2 workbooks
>from where the data is being copied from will change),

>or

>    allow input into a message box of the range to be copied (given that
>this option would occur 6 times each time the macro is invoked)?

>Any help would be greatly appreciated.

>TIA

>Bob
>Maitland   Australia



Thu, 04 Oct 2001 03:00:00 GMT  
 Macro to Copy 2 Wb Ranges into 3rd Wb.
Bob,

How are things down under?

First, I questioned whether you wanted to copy range
[Book 2]Sheet1!A2:A46  to all 3 locations in Base 3.  That
is the way you specified the problem.

Second, I wasn't sure whether Base 3 is an existing workbook.
I assumed that it is an existing workbook to be opened.

Third I assumed that you wanted to copy the values and not
formulas.

Based on these assumptions, this macro should get you started:

Public Book1File As Variant      'The Book1 file name; includes the path
Public Book1Book As Workbook
Public Book1Sheet As Worksheet     'The sheet in the Book1 book being used

Public Book2File As Variant      'The Book2 file name; includes the path
Public Book2Book As Workbook
Public Book2Sheet As Worksheet     'The sheet in the Book2 book being used

Public Base3File As Variant      'This is the book to write to; includes the
path
Public Base3Book As Workbook
Public Base3Sheet As Worksheet     'The sheet in the Base3 book being used

Sub MainRoutine()

OpenFiles

Greeting = "Morning!"
Msgtxt = "Do you want to copy the standard ranges?"
    Reply = MsgBox(Msgtxt, vbYesNo, Greeting)
    If Reply = 6 Then               'If response is yes
        CopyStdRanges
    Else
        CopyInputRanges
    End If

SaveMyFile

End Sub

Sub OpenFiles()

currentdir = CurDir                'Get the current directory
currentdrive = Left(CurDir, 1)     'Get the current drive

'*****NOTE  The following statements change the drive and path
    ChDrive "c"                  'change the drive to use
    ChDir ("c:\test\")

'NOTE:  I don't check whether these files are already open

'Open the Book1 file:
    Book1File = Application.GetOpenFilename _
           ("Excel Files (*.xl?), *.xl?", , "Open the Book 1 File", , False)
'NOTE:  At this point, Book1Book contains the path and the file name
             If Book1File = False Then GoTo Cancel     'If cancel selected

             'Open the file selected
             Workbooks.Open FileName:=Book1File, updatelinks:=0
            Set Book1Book = ActiveWorkbook
            Set Book1Sheet = Book1Book.Sheets("sheet1")

'Open the Book2 file:
    Book2File = Application.GetOpenFilename _
           ("Excel Files (*.xl?), *.xl?", , "Open the Book 2 File", , False)
             If Book2File = False Then GoTo Cancel     'If cancel selected

             'Open the file selected
             Workbooks.Open FileName:=Book2File, updatelinks:=0
            Set Book2Book = ActiveWorkbook
            Set Book2Sheet = Book2Book.Sheets("sheet1")

'Open the Book 3 File
    Base3File = Application.GetOpenFilename _
           ("Excel Files (*.xl?), *.xl?", , "Open the Book 3 File", , False)
        If Base3File = False Then GoTo Cancel

             'Open the file selected
             Workbooks.Open FileName:=Base3File, updatelinks:=0
            Set Base3Book = ActiveWorkbook
            Set Base3Sheet = Base3Book.Sheets("sheet1")
'Reset the drive and path the the previous defaults
ChDrive currentdrive
ChDir currentdir
Application.StatusBar = False

Exit Sub

    'If cancel was selected, displays a message and exits the macro
Cancel:
     MsgBox "Cancel Selected:  Macro Terminating."
     End

End Sub

Sub CopyStdRanges()

    Set Base3Sheet = Base3Book.Sheets("sheet1")
    Base3Sheet.Range("a2:a46").Value = Book1Sheet.Range("a2:a46").Value
    Base3Sheet.Range("d2:d46").Value = Book1Sheet.Range("b2:b46").Value
    Base3Sheet.Range("h2:h46").Value = Book1Sheet.Range("c2:c46").Value

    Set Base3Sheet = Base3Book.Sheets("sheet2")
    Base3Sheet.Range("a2:a46").Value = Book2Sheet.Range("a2:a46").Value
    Base3Sheet.Range("d2:d46").Value = Book2Sheet.Range("a2:a46").Value
    Base3Sheet.Range("h2:h46").Value = Book2Sheet.Range("a2:a46").Value

End Sub

Sub CopyInputRanges()
    'I stole this from Chip Pearson.  Thanks, Chip!
Dim TheRange As Range
Dim i As Integer

Book1Book.Activate
Set Base3Sheet = Base3Book.Sheets("sheet1")

'Get 6 ranges and copy to Base3
For i = 1 To 6
On Error Resume Next
Set TheRange = Application.InputBox _
            (prompt:=("Select range " & i & " to copy"), Type:=8)
If Not TheRange Is Nothing Then
    Select Case i
    Case 1
        TheRange.Copy _
            Destination:=Base3Sheet.Range("a2")
    Case 2
        TheRange.Copy _
            Destination:=Base3Sheet.Range("d2")
    Case 3
        TheRange.Copy _
            Destination:=Base3Sheet.Range("h2")
    'Get the last 3 ranges from Book2 and paste to sheet 2 of Base3
        Book2Book.Activate
        Set Base3Sheet = Base3Book.Sheets("sheet2")
    Case 4
        TheRange.Copy _
            Destination:=Base3Sheet.Range("a2")
    Case 5
        TheRange.Copy _
            Destination:=Base3Sheet.Range("d2")
    Case 6
        TheRange.Copy _
            Destination:=Base3Sheet.Range("h2")

    Case Else
        MsgBox "Fell through the Select Case logic"
    End Select

Else
    MsgBox "You cancelled. TheRange is undefined. This logic not tested"

End If

Next i

End Sub

Sub SaveMyFile()
    Base3Book.Activate
    Application.Dialogs(xlDialogSaveAs).Show
'    Base3Book.Close
    Book2Book.Close
    Book1Book.Close
    MsgBox "The ranges have been successfully copied"

End Sub

HTH,

Brian

Quote:

> Hi, XL97.

> I need to combine ranges in 2 workbooks into a 3rd base workbook.

> There are some 60 projects, each with 2 workbooks that require info transfer
> to an updated "base" workbook.

> Here is what I need to do 60 times.
> 3 separate workbooks, Book 1, Book 2, and Base3.

> I need to copy the following ranges from Books 1 & 2 into Base 3.

> [Book 1]Sheet1!A2:A46  to [Base 3]Sheet1!A2:A46.
> [Book 1]Sheet1!B2:B46  to [Base 3]Sheet1!D2:D46.
> [Book 1]Sheet1!C2:C46  to [Base 3]Sheet1!H2:H46.

> [Book 2]Sheet1!A2:A46  to [Base 3]Sheet2!A2:A46.
> [Book 2]Sheet1!A2:A46  to [Base 3]Sheet2!D2:D46.
> [Book 2]Sheet1!A2:A46  to [Base 3]Sheet2!H2:H46.

> The "Base 3" workbook is then saved under a separate name.

> The process then needs to be repeated with the balance of project files and
> the "Base3" workbook.

> To do this copy/paste manually would take some time.

> Is it feasible to create a macro and pause it to either:

>      allow input into a message box of the file names from where the data is
> to be copied from (given the cell reference ranges for all files will remain
> constant, as will the Base 3 workbook name and cells. Only the 2 workbooks
> from where the data is being copied from will change),

> or

>     allow input into a message box of the range to be copied (given that
> this option would occur 6 times each time the macro is invoked)?

> Any help would be greatly appreciated.

> TIA

> Bob
> Maitland   Australia



Tue, 09 Oct 2001 03:00:00 GMT  
 Macro to Copy 2 Wb Ranges into 3rd Wb.
I have what I believe to be a simple problem, though
I can't find anything in the help files or numerous
reference books that will show me how to do the
following.  I want to extract data from approximately
1000 or so files into one spreadsheet.  The 3 data entries
to be extracted from each of the 1000+ files is in ascii
format and is always located on the
same position in the worksheets (for example A15; D24;
D32, once it is converted).  I would like the resulting
final spreadsheet to contain a compilation of all the data
into 3 columns.  I can't figure out how to do this with
the macros or visual basic, though, as it may already
be obvious, I know very little about either.
Please help!  This is simply too time consuming to
do by hand!

Thanks in advance!!

frank



Sun, 06 Jan 2002 03:00:00 GMT  
 Macro to Copy 2 Wb Ranges into 3rd Wb.


Quote:
>I have what I believe to be a simple problem, though
>I can't find anything in the help files or numerous
>reference books that will show me how to do the
>following.  I want to extract data from approximately
>1000 or so files into one spreadsheet.  The 3 data entries
>to be extracted from each of the 1000+ files is in ascii
>format and is always located on the
>same position in the worksheets (for example A15; D24;
>D32, once it is converted).  I would like the resulting
>final spreadsheet to contain a compilation of all the data
>into 3 columns.  I can't figure out how to do this with
>the macros or visual basic, though, as it may already
>be obvious, I know very little about either.
>Please help!  This is simply too time consuming to
>do by hand!

As far as a macro is concerned, let's assume all of the source files are in the
same directory, and I'll call it C:\Excel\Excel2. I'll also assume that the
sheet to receive the data is active when you run the macro, that is has headers
in row 1, and the new data will start in row 2.

You need to change this macro: change the line that specifies the source
directory, and the one that specifies the cells from which to retrieve the
data, and the starting column where the data is to be written. These lines are
marked with "<<<"

Sub GetData()
  Dim SourceDir As String
  Dim SourceCells As Variant
  Dim StartCol As Integer
  Dim sFileNames() As String
  Dim sMyName As String
  Dim sTemp As String
  Dim N As Integer
  Dim DestSheet As Worksheet
  Dim R As Integer
  Dim Col As Integer
  Dim F As Integer
  Dim C As Integer
  Dim C1 As Integer
  Dim C2 As Integer

  SourceDir = "C:\Excel\Excel2"              '<<<
  SourceCells = Array("A15", "D24", "D32")   '<<<
  StartCol = 1                               '<<< column to hold 1st data item

  ReDim sFileNames(1 To 1000) As String

  sMyName = ThisWorkbook.Name
  N = 0
  sTemp = Dir$(SourceDir & "\" & "*.xls")
  Do While Len(sTemp)
    If sTemp <> sMyName Then
      N = N + 1
      If N > UBound(sFileNames) Then
        ReDim Preserve sFileNames(1 To N + 50)
      End If
      sFileNames(N) = sTemp
    End If
    sTemp = Dir$()
  Loop

  If N = 0 Then
    MsgBox "No files found"
    Exit Sub
  End If

  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
  End With

  C1 = LBound(SourceCells)
  C2 = UBound(SourceCells)
  Set DestSheet = ActiveSheet  'assumes this is active when macro is called
  R = 1                        'row number on destination sheet
  For F = 1 To N
    R = R + 1
    With Workbooks.Open(SourceDir & "\" & sFileNames(F)).Worksheets(1)
      Col = StartCol
      For C = C1 To C2
        DestSheet.Cells(R, Col).Value = .Range(SourceCells(C)).Value
        Col = Col + 1
      Next C
      'DestSheet.Cells(R, Col).Value = sFileNames(F)
      .Parent.Close SaveChanges:=False
    End With
  Next F

  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
  End With
End Sub



Mon, 07 Jan 2002 03:00:00 GMT  
 Macro to Copy 2 Wb Ranges into 3rd Wb.
Something like:

myfilename=Dir("C:\sourcedirectory\*.*")
i = 1
while myfilename<>""
  Workbooks.open filename:=myfilename
  var1=cells(1, 3).value
  var2=cells(4, 5).value
  var3=cells(7, 9).value
  Activewindow.close
  cells(i, 1)=var1
  cells(i, 2)=var2
  cells(i, 3)=var3
  i = i + 1
  myfilename=Dir()
wend

Sould work



Quote:
> I have what I believe to be a simple problem, though
> I can't find anything in the help files or numerous
> reference books that will show me how to do the
> following.  I want to extract data from approximately
> 1000 or so files into one spreadsheet.  The 3 data entries
> to be extracted from each of the 1000+ files is in ascii
> format and is always located on the
> same position in the worksheets (for example A15; D24;
> D32, once it is converted).  I would like the resulting
> final spreadsheet to contain a compilation of all the data
> into 3 columns.  I can't figure out how to do this with
> the macros or visual basic, though, as it may already
> be obvious, I know very little about either.
> Please help!  This is simply too time consuming to
> do by hand!

> Thanks in advance!!

> frank

--
He just chuckles and smiles
and laughs like a madman
Ladies and gentlemen,
I give you . . . SHERIFF FATMAN!

Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.



Tue, 08 Jan 2002 03:00:00 GMT  
 
 [ 6 post ] 

 Relevant Pages 

1. setting range size automatically for copying to other WB

2. Copy range from one WB to another

3. Macro to run a macro in 6 identical WB's

4. Scheduled Task - Open WB, Run macro, Delete macro, Save As

5. select range in diff wb, with inputbox

6. Access-Excel automation, ranges, & wb protection

7. Copying module to New WB using VBA

8. Copy Sheet to another WB without activating it?

9. Code to copy and paste to new wb not functioning

10. Disk is full error message on copying sheets from one wb to another


 
Powered by phpBB® Forum Software © phpBB Group