PC Review


Reply
Thread Tools Rate Thread

combine two workbooks

 
 
jeremy1404@gmail.com
Guest
Posts: n/a
 
      20th Jun 2007
Hello,

I have two files with similar data. I am using Ron de Bruin's
fantastic "Create new workbook for all unique values" code on his
website to seperate the files. I am using the same unique value, for
instance "connectors," "cables," "metal", to seperate both files.
What I am looking to do is to save the output of both files in the
same workbook yet on different worksheets.

Thank you all in advance for your help. I have used the advice found
here many times!!

I have posted Ron's code below:

Sub Copy_With_AdvancedFilter_To_Workbooks()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim foldername As String
Dim MyPath As String

Set ws1 = Sheets("Sheet1") '<<< Change
'Set filter range : A1 is the top left cell of your filter range
and
'the header of the first column, D is the last column in the
filter range
Set rng = ws1.Range("A1" & Rows.Count)

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

' Add worksheet to copy the a unique list and add the
CriteriaRange
Set ws2 = Worksheets.Add

'Fill in the path\folder where you want the new folder with the
files
'you can use also this "C:\Users\Ron\test"
MyPath = Application.DefaultFilePath

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'Create folder for the new files
foldername = MyPath & Format(Now, "yyyy-mm-dd hh-mm-ss") & "\"
MkDir foldername

With ws2
'This example filters on the first column in the range
'first we copy the Unique data from this column to ws2
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("B1"), Unique:=True

'Then give A1 the same value as B1 (header of column 1) in ws2
.Range("A1").Value = .Range("B1").Value

'loop through the unique list in ws2 and filter/copy to a new
workbook
Lrow = .Cells(Rows.Count, "B").End(xlUp).Row
For Each cell In .Range("B2:B" & Lrow)
.Range("A2").Value = "=" & Chr(34) & "=" & cell.Value &
Chr(34)
Set WSNew = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("A1:A2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit

'Save the file in the newfolder and close it
WSNew.Parent.SaveAs foldername & " Value = " _
& cell.Value, ws1.Parent.FileFormat
WSNew.Parent.Close False
Next

'Delete the ws2 sheet
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0

End With

MsgBox "Look in " & foldername & " for the files"

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

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Combine two workbooks into one btate Microsoft Excel Programming 2 20th May 2008 04:19 PM
Combine workbooks Pat Brewington Microsoft Excel Discussion 13 16th Dec 2006 09:42 PM
How do I combine different workbooks into one? =?Utf-8?B?UGF0cmljaWE=?= Microsoft Excel Programming 2 29th Aug 2006 02:52 PM
Trying to Combine Workbooks ryan.lindner@gmail.com Microsoft Excel Programming 2 19th Apr 2006 01:54 AM
Combine Workbooks LRL Microsoft Excel Programming 1 17th Dec 2005 04:56 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 02:31 PM.