Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Mult. Wkshts Into Single Wkbk
I gather business results from multiple users in Excel workbooks. The
workbooks are identical in every respect except for file name and, of course, results data users enter for their respective businesses. All of the workbooks and worksheets are protected. My objective is to utylize VBA code that will when exectued: 1) Prompt me to select the directory where the user workbooks are located, then 2) Loop through each of the workbooks in that directory and copy data from the same range each of those source workbooks into my active workbook, and 3) Rename each copied worksheet using a three digit numeric value "000" in cell "d2" of each worksheet that has been copied. The name of the copied worksheets would thus be 001, 002, 003, etc., then 4) No changes are saved to the source workbooks once the data copy action is completed and the source worksheets and workbooks remain protected with no loss of data when they are closed. For more than a month I have pieced together snipets of code (see below) which seems to almost achieve my purpose. What I really want is to copy only cell values and formats from each of the source worksheets without copying all of the worksheets with underlying formulas. It would suffice if I could copy cell values and formats from specific ranges from the source worksheets rather than copying the entire source worksheet (i.e., three or four ranges, for example: Row2 thru Row5, b6:f29, k6:k29, and m6:m29). I just don't know how to tweak the code to do that. I appreciate any advise as to how to copy only cell values and formats from the multiple sources worksheets rather than to copy the entire worksheet. Would someone be kind enough to help me with code ideas or recommendations? TIA, Mike Taylor, Enthusiastic Beginner ------------------------------------------------------------------ Sub GetSheets() Dim i As Long Dim varr As Variant Dim wkbk As Workbook Dim sh As Object Dim mybook As Workbook Dim myExistingPath As String Dim myPathToRetrieve As String myExistingPath = CurDir myPathToRetrieve = "c:\data\datafiles\jan" ChDrive myPathToRetrieve ChDir myPathToRetrieve varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _ MultiSelect:=True) If IsArray(varr) Then For i = LBound(varr) To UBound(varr) Set wkbk = Workbooks.Open(varr(i)) With wkbk.Worksheets("Results Report 2004") On Error Resume Next 'For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) For Each sh In mybook.Sheets ActiveWorkbook.Unprotect ("mbt") ActiveSheet.Unprotect ("mbt") Next sh mybook.Close SaveChanges:=False 'Next i .Name = .Range("d2").Value 'If Err.Number < 0 Then 'MsgBox .Name & " Couldn't be renamed" 'Err.Clear 'End If .UsedRange.Value = .UsedRange.Value .Copy after:=ThisWorkbook. _ Worksheets(ThisWorkbook.Worksheets.Count) ActiveSheet.Name = Format(123, "000") 'testing worksheet name - delete if not working End With wkbk.Close SaveChanges:=False Next End If 'reset it back ChDrive myExistingPath ChDir myExistingPath End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Mult. Wkshts Into Single Wkbk
Hi Mike
for copying single cells you may have a look at http://www.rondebruin.nl/copy2.htm -- Regards Frank Kabel Frankfurt, Germany "Mike Taylor" schrieb im Newsbeitrag om... I gather business results from multiple users in Excel workbooks. The workbooks are identical in every respect except for file name and, of course, results data users enter for their respective businesses. All of the workbooks and worksheets are protected. My objective is to utylize VBA code that will when exectued: 1) Prompt me to select the directory where the user workbooks are located, then 2) Loop through each of the workbooks in that directory and copy data from the same range each of those source workbooks into my active workbook, and 3) Rename each copied worksheet using a three digit numeric value "000" in cell "d2" of each worksheet that has been copied. The name of the copied worksheets would thus be 001, 002, 003, etc., then 4) No changes are saved to the source workbooks once the data copy action is completed and the source worksheets and workbooks remain protected with no loss of data when they are closed. For more than a month I have pieced together snipets of code (see below) which seems to almost achieve my purpose. What I really want is to copy only cell values and formats from each of the source worksheets without copying all of the worksheets with underlying formulas. It would suffice if I could copy cell values and formats from specific ranges from the source worksheets rather than copying the entire source worksheet (i.e., three or four ranges, for example: Row2 thru Row5, b6:f29, k6:k29, and m6:m29). I just don't know how to tweak the code to do that. I appreciate any advise as to how to copy only cell values and formats from the multiple sources worksheets rather than to copy the entire worksheet. Would someone be kind enough to help me with code ideas or recommendations? TIA, Mike Taylor, Enthusiastic Beginner ------------------------------------------------------------------ Sub GetSheets() Dim i As Long Dim varr As Variant Dim wkbk As Workbook Dim sh As Object Dim mybook As Workbook Dim myExistingPath As String Dim myPathToRetrieve As String myExistingPath = CurDir myPathToRetrieve = "c:\data\datafiles\jan" ChDrive myPathToRetrieve ChDir myPathToRetrieve varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _ MultiSelect:=True) If IsArray(varr) Then For i = LBound(varr) To UBound(varr) Set wkbk = Workbooks.Open(varr(i)) With wkbk.Worksheets("Results Report 2004") On Error Resume Next 'For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) For Each sh In mybook.Sheets ActiveWorkbook.Unprotect ("mbt") ActiveSheet.Unprotect ("mbt") Next sh mybook.Close SaveChanges:=False 'Next i .Name = .Range("d2").Value 'If Err.Number < 0 Then 'MsgBox .Name & " Couldn't be renamed" 'Err.Clear 'End If .UsedRange.Value = .UsedRange.Value .Copy after:=ThisWorkbook. _ Worksheets(ThisWorkbook.Worksheets.Count) ActiveSheet.Name = Format(123, "000") 'testing worksheet name - delete if not working End With wkbk.Close SaveChanges:=False Next End If 'reset it back ChDrive myExistingPath ChDir myExistingPath End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Mult. Wkshts Into Single Wkbk
http://www.rondebruin.nl/copy3.htm
For ranges from different workbooks see this page -- Regards Ron de Bruin http://www.rondebruin.nl "Frank Kabel" wrote in message ... Hi Mike for copying single cells you may have a look at http://www.rondebruin.nl/copy2.htm -- Regards Frank Kabel Frankfurt, Germany "Mike Taylor" schrieb im Newsbeitrag om... I gather business results from multiple users in Excel workbooks. The workbooks are identical in every respect except for file name and, of course, results data users enter for their respective businesses. All of the workbooks and worksheets are protected. My objective is to utylize VBA code that will when exectued: 1) Prompt me to select the directory where the user workbooks are located, then 2) Loop through each of the workbooks in that directory and copy data from the same range each of those source workbooks into my active workbook, and 3) Rename each copied worksheet using a three digit numeric value "000" in cell "d2" of each worksheet that has been copied. The name of the copied worksheets would thus be 001, 002, 003, etc., then 4) No changes are saved to the source workbooks once the data copy action is completed and the source worksheets and workbooks remain protected with no loss of data when they are closed. For more than a month I have pieced together snipets of code (see below) which seems to almost achieve my purpose. What I really want is to copy only cell values and formats from each of the source worksheets without copying all of the worksheets with underlying formulas. It would suffice if I could copy cell values and formats from specific ranges from the source worksheets rather than copying the entire source worksheet (i.e., three or four ranges, for example: Row2 thru Row5, b6:f29, k6:k29, and m6:m29). I just don't know how to tweak the code to do that. I appreciate any advise as to how to copy only cell values and formats from the multiple sources worksheets rather than to copy the entire worksheet. Would someone be kind enough to help me with code ideas or recommendations? TIA, Mike Taylor, Enthusiastic Beginner ------------------------------------------------------------------ Sub GetSheets() Dim i As Long Dim varr As Variant Dim wkbk As Workbook Dim sh As Object Dim mybook As Workbook Dim myExistingPath As String Dim myPathToRetrieve As String myExistingPath = CurDir myPathToRetrieve = "c:\data\datafiles\jan" ChDrive myPathToRetrieve ChDir myPathToRetrieve varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _ MultiSelect:=True) If IsArray(varr) Then For i = LBound(varr) To UBound(varr) Set wkbk = Workbooks.Open(varr(i)) With wkbk.Worksheets("Results Report 2004") On Error Resume Next 'For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) For Each sh In mybook.Sheets ActiveWorkbook.Unprotect ("mbt") ActiveSheet.Unprotect ("mbt") Next sh mybook.Close SaveChanges:=False 'Next i .Name = .Range("d2").Value 'If Err.Number < 0 Then 'MsgBox .Name & " Couldn't be renamed" 'Err.Clear 'End If .UsedRange.Value = .UsedRange.Value .Copy after:=ThisWorkbook. _ Worksheets(ThisWorkbook.Worksheets.Count) ActiveSheet.Name = Format(123, "000") 'testing worksheet name - delete if not working End With wkbk.Close SaveChanges:=False Next End If 'reset it back ChDrive myExistingPath ChDir myExistingPath End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I copy records with specific text from one wkbk to another | Excel Worksheet Functions | |||
How to copy several wkshts into one worksht with formulas? | Excel Worksheet Functions | |||
Color a single digit in a mult-digit number cell | Excel Discussion (Misc queries) | |||
Transpose unique values in one column/mult. rows into a single row | Excel Worksheet Functions | |||
I want to be able to insert 1 Excel Wkbk (w mult tabs) into anothe | Excel Worksheet Functions |