copy dynamic ranges in multiple workbooks based on a data in 1 col

J

jbsand1001

This is my dilemma:

Column "A" from workbook 3 paste into column "C" into the new workbook and
column "A" from workbook 4 paste in the first open cell in column "C" in the
new workbook. Column "B" in workbook 3 and 4 work the same way except they
paste into column "D" in the new workbook.

So what I need to do is concentrate and follow the data range pasted in
column "A" from both workbook 3 and 4. So if the data in workbook 3 column
"A" has a range of "A1:A10" it will paste into the new workbook in column "C"
with the same range "C1:C10". But if the data in workbook 3 column "B" only
has a range of "B1:B8" it will paste in the new workbook column "D1:D8". The
data from workbook 4 columns "A" and "B" will paste in the first open cell
under the data from workbook 3. Here in lies the problem, I need for it to
recognize the need for blank cells in column "B" so that it paste the data
from workbook 4 column "B" starting at "D11". I have illustrated this below
the code.

Sub Quotesheetwithworkbookopen()
Workbooks.Open Filename:="C:\Documents and Settings\Default\My
Documents\macros\book3.xls"

'If each column has a heading, change the 1's to 2's
Dim myRange As Range
Dim ActSheet As Worksheet
Dim newSheet As Worksheet

Set ActSheet = ActiveSheet

With ActSheet
Set myRange = .Range("A1", .Range("A1").End(xlDown))
End With

Workbooks.Add
Set newSheet = ActiveWorkbook.Sheets("Sheet1") '<-- in the new workbook

myRange.Copy _
Destination:=newSheet.Range("C1")

With ActSheet
Set myRange = .Range("B1", .Range("B1").End(xlDown))
End With

myRange.Copy _
Destination:=newSheet.Range("d1")

Workbooks("book3.xls").Close

Workbooks.Open Filename:="C:\Documents and Settings\Default\My
Documents\macros\book4.xls"

'If each column has a heading, change the 1's to 2's

Set ActSheet = ActiveSheet

With ActSheet
Set myRange = .Range("A1", .Range("A1").End(xlDown))
End With

myRange.Copy _
Destination:=newSheet.Range("c65536").End(xlUp).Offset(1)


With ActSheet
Set myRange = .Range("B1", .Range("B1").End(xlDown))
End With

myRange.Copy _
Destination:=newSheet.Range("d65536").End(xlUp).Offset(1)

Workbooks("book4.xls").Close


End Sub


Column A workbook3 Column B Workbook3
Workbook 3 1
Workbook 3 2
Workbook 3 3
Workbook 3 4
Workbook 3 5
Workbook 3 6
Workbook 3 "Blank"
Workbook 3 "Blank"
Column A workbook 4 Column B Workbook 4
Workbook 4 30/04/2005
Workbook 4 30/04/2005
Workbook 4 30/04/2005
Workbook 4 30/04/2005
Workbook 4 30/04/2005
Workbook 4 30/04/2005



Thank You,

Judd
 

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

Top