Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy the same column from 50 sheets into a new sheet macro help!
Hey folks,
I have a macro that works great in running a macro on all files in a folder, but now I need a macro to copy the same column (column I) from each of the 50 sheets in the folder and paste all of them into a new worksheet starting at column A and continuing down the line. Help! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy the same column from 50 sheets into a new sheet macro help!
Rather than rewriting code that works, why not paste your code in and someone
can show you how to modify it. -- Regards, Tom Ogilvy " wrote: Hey folks, I have a macro that works great in running a macro on all files in a folder, but now I need a macro to copy the same column (column I) from each of the 50 sheets in the folder and paste all of them into a new worksheet starting at column A and continuing down the line. Help! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy the same column from 50 sheets into a new sheet macro help!
Sorry about that!
Here is what I have so far (gleaned from pouring through newsgroups): Sub Compile() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim SourceRcount As Long Dim FNames As String Dim MyPath As String Dim SaveDriveDir As String SaveDriveDir = CurDir MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey" ChDrive MyPath ChDir MyPath FNames = Dir("*.xls") If Len(FNames) = 0 Then MsgBox "No files in the Directory" ChDrive SaveDriveDir ChDir SaveDriveDir Exit Sub End If Application.ScreenUpdating = False Set basebook = ThisWorkbook basebook.Worksheets(1).Cells.Clear 'clear all cells on the first sheet rnum = 1 Do While FNames < "" If LCase(Left(FNames, 4)) < "survey" Then Set mybook = Workbooks.Open(FNames) Set sourceRange = mybook.Worksheets(1).Range("I1:I140") SourceRcount = sourceRange.Rows.Count Set destrange = basebook.Worksheets(1).Cells(rnum, 1) ' basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name ' This will add the workbook name in column D if you want sourceRange.Copy destrange 'Instead of this line you can use the code below to copy only the values ' With sourceRange ' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _ ' Resize(.Rows.Count, ..Columns.Count) ' End With ' destrange.Value = sourceRange.Value rnum = rnum + SourceRcount mybook.Close False End If FNames = Dir() Loop ChDrive SaveDriveDir ChDir SaveDriveDir Application.ScreenUpdating = True End Sub What I get with this is all of the data copied over... but all of it copied into Column A and I need it copied into subsequent columns (think N+1). Rob Tom Ogilvy wrote: Rather than rewriting code that works, why not paste your code in and someone can show you how to modify it. -- Regards, Tom Ogilvy " wrote: Hey folks, I have a macro that works great in running a macro on all files in a folder, but now I need a macro to copy the same column (column I) from each of the 50 sheets in the folder and paste all of them into a new worksheet starting at column A and continuing down the line. Help! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy the same column from 50 sheets into a new sheet macro help!
You can use this :
Sub Valuefromfileinfolder() dim r as long For r = 1 To 50 '50 means numbers of file in a folder c:\ with range("A" & r) .FormulaArray = "='C:\[Book" & r & ".xls]Sheet1'!I1 'book in folder c:\ must be named "Book1.xls" up to "Book50.xls" .Value=.value end with next r end sub Try it, Halim wrote: Hey folks, I have a macro that works great in running a macro on all files in a folder, but now I need a macro to copy the same column (column I) from each of the 50 sheets in the folder and paste all of them into a new worksheet starting at column A and continuing down the line. Help! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy the same column from 50 sheets into a new sheet macro help!
You can use this :
Sub Valuefromfileinfolder() dim r as long For r = 1 To 50 '50 means numbers of file in a folder c:\ with range("A" & r) .FormulaArray = "='C:\[Book" & r & ".xls]Sheet1'!I1 'book in folder c:\ must be named "Book1.xls" up to "Book50.xls" .Value=.value end with next r end sub I tried that and it gave me all kinds of object and compile errors. I assumed that the formatting got a little wonky in the c&p so I tinkered around with it a bit, but it still seems to be fighting back. ;) r |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy the same column from 50 sheets into a new sheet macro hel
Sub Compile()
Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim SourceRcount As Long Dim FNames As String Dim MyPath As String Dim SaveDriveDir As String SaveDriveDir = CurDir MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey" ChDrive MyPath ChDir MyPath FNames = Dir("*.xls") If Len(FNames) = 0 Then MsgBox "No files in the Directory" ChDrive SaveDriveDir ChDir SaveDriveDir Exit Sub End If Application.ScreenUpdating = False Set basebook = ThisWorkbook basebook.Worksheets(1).Cells.Clear 'clear all cells on the first sheet rnum = 0 Do While FNames < "" If LCase(Left(FNames, 4)) < "survey" Then Set mybook = Workbooks.Open(FNames) rnum = rnum + 1 Set sourceRange = mybook.Worksheets(1).Range("I1:I140") Set destrange = basebook.Worksheets(1).Cells(2, rNum) basebook.Worksheets(1).Cells(1, rnum).Value = mybook.Name sourceRange.Copy destrange mybook.Close False End If FNames = Dir() Loop ChDrive SaveDriveDir ChDir SaveDriveDir Application.ScreenUpdating = True End Sub -- Regards, Tom Ogilvy " wrote: Sorry about that! Here is what I have so far (gleaned from pouring through newsgroups): Sub Compile() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim SourceRcount As Long Dim FNames As String Dim MyPath As String Dim SaveDriveDir As String SaveDriveDir = CurDir MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey" ChDrive MyPath ChDir MyPath FNames = Dir("*.xls") If Len(FNames) = 0 Then MsgBox "No files in the Directory" ChDrive SaveDriveDir ChDir SaveDriveDir Exit Sub End If Application.ScreenUpdating = False Set basebook = ThisWorkbook basebook.Worksheets(1).Cells.Clear 'clear all cells on the first sheet rnum = 1 Do While FNames < "" If LCase(Left(FNames, 4)) < "survey" Then Set mybook = Workbooks.Open(FNames) Set sourceRange = mybook.Worksheets(1).Range("I1:I140") SourceRcount = sourceRange.Rows.Count Set destrange = basebook.Worksheets(1).Cells(rnum, 1) ' basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name ' This will add the workbook name in column D if you want sourceRange.Copy destrange 'Instead of this line you can use the code below to copy only the values ' With sourceRange ' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _ ' Resize(.Rows.Count, ..Columns.Count) ' End With ' destrange.Value = sourceRange.Value rnum = rnum + SourceRcount mybook.Close False End If FNames = Dir() Loop ChDrive SaveDriveDir ChDir SaveDriveDir Application.ScreenUpdating = True End Sub What I get with this is all of the data copied over... but all of it copied into Column A and I need it copied into subsequent columns (think N+1). Rob Tom Ogilvy wrote: Rather than rewriting code that works, why not paste your code in and someone can show you how to modify it. -- Regards, Tom Ogilvy " wrote: Hey folks, I have a macro that works great in running a macro on all files in a folder, but now I need a macro to copy the same column (column I) from each of the 50 sheets in the folder and paste all of them into a new worksheet starting at column A and continuing down the line. Help! |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy the same column from 50 sheets into a new sheet macro help!
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy the same column from 50 sheets into a new sheet macro hel
Rock on! Thanks, Tom - that worked like a champ!
Now... the fun and joy of creating pivot tables with all of this data... Tom Ogilvy wrote: Sub Compile() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim SourceRcount As Long Dim FNames As String Dim MyPath As String Dim SaveDriveDir As String SaveDriveDir = CurDir MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey" ChDrive MyPath ChDir MyPath FNames = Dir("*.xls") If Len(FNames) = 0 Then MsgBox "No files in the Directory" ChDrive SaveDriveDir ChDir SaveDriveDir Exit Sub End If Application.ScreenUpdating = False Set basebook = ThisWorkbook basebook.Worksheets(1).Cells.Clear 'clear all cells on the first sheet rnum = 0 Do While FNames < "" If LCase(Left(FNames, 4)) < "survey" Then Set mybook = Workbooks.Open(FNames) rnum = rnum + 1 Set sourceRange = mybook.Worksheets(1).Range("I1:I140") Set destrange = basebook.Worksheets(1).Cells(2, rNum) basebook.Worksheets(1).Cells(1, rnum).Value = mybook.Name sourceRange.Copy destrange mybook.Close False End If FNames = Dir() Loop ChDrive SaveDriveDir ChDir SaveDriveDir Application.ScreenUpdating = True End Sub -- Regards, Tom Ogilvy " wrote: Sorry about that! Here is what I have so far (gleaned from pouring through newsgroups): Sub Compile() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim SourceRcount As Long Dim FNames As String Dim MyPath As String Dim SaveDriveDir As String SaveDriveDir = CurDir MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey" ChDrive MyPath ChDir MyPath FNames = Dir("*.xls") If Len(FNames) = 0 Then MsgBox "No files in the Directory" ChDrive SaveDriveDir ChDir SaveDriveDir Exit Sub End If Application.ScreenUpdating = False Set basebook = ThisWorkbook basebook.Worksheets(1).Cells.Clear 'clear all cells on the first sheet rnum = 1 Do While FNames < "" If LCase(Left(FNames, 4)) < "survey" Then Set mybook = Workbooks.Open(FNames) Set sourceRange = mybook.Worksheets(1).Range("I1:I140") SourceRcount = sourceRange.Rows.Count Set destrange = basebook.Worksheets(1).Cells(rnum, 1) ' basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name ' This will add the workbook name in column D if you want sourceRange.Copy destrange 'Instead of this line you can use the code below to copy only the values ' With sourceRange ' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _ ' Resize(.Rows.Count, ..Columns.Count) ' End With ' destrange.Value = sourceRange.Value rnum = rnum + SourceRcount mybook.Close False End If FNames = Dir() Loop ChDrive SaveDriveDir ChDir SaveDriveDir Application.ScreenUpdating = True End Sub What I get with this is all of the data copied over... but all of it copied into Column A and I need it copied into subsequent columns (think N+1). Rob Tom Ogilvy wrote: Rather than rewriting code that works, why not paste your code in and someone can show you how to modify it. -- Regards, Tom Ogilvy " wrote: Hey folks, I have a macro that works great in running a macro on all files in a folder, but now I need a macro to copy the same column (column I) from each of the 50 sheets in the folder and paste all of them into a new worksheet starting at column A and continuing down the line. Help! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy rows of one sheet into mutiple sheets based on column value | Excel Discussion (Misc queries) | |||
Macro to copy Column 1 of all sheets to a seperate sheet. | Excel Programming | |||
in VBA Sheets("mysheet").Copy Befo=Sheets(1) how do i get a reference to the newly created copy of this sheet? | Excel Worksheet Functions | |||
MACRO - copy rows based on value in column to another sheet | Excel Discussion (Misc queries) | |||
MACRO - copy rows based on value in column to another sheet | Excel Programming |