Sunday, August 2, 2009

Question about Excel Macros and VBA - copy / paste ranges?

So here is what I am trying to accomplish:





I want to create a macro that will take ranges of cells from multiple other workbook/worksheets, copy the entire range of text (this is a variable amount on each sheet, so it needs to pull all data in the worksheet), and then paste into my worksheet. Then, it would delete the last line of the text (as it is subtotals that I do not need), and then copy the next range and append the info to what was pasted from the other sheet.





If I made this sound weird, I want the macro to:


-open up workbook B (I can create the macro for this, so this syntax is not needed)


-copy range that has cells in it (example, if text is in A1:L7, copy that)


-paste info into Workbook A


-delete the last line of info


-Open Workbook C


-Copy range that has data (for this example A1:L10)


-paste info AFTER data from prior copy/paste into Workbook A to append the data.


-so on and so forth for all of the files.





THANK YOU for any leads you can give.

Question about Excel Macros and VBA - copy / paste ranges?
This should do what you need. Feel free to changes to make the code fit your particular sheet. You'll need to list each workbook path %26amp; name in column one of a worksheet. The code will loop through these workbooks, open them %26amp; copy their data.





Sub Macro1()


'starting with A1, put the workbook paths in each cell in the column like


'C:\TEMP\Book1.xls








Dim rngName As Range





ActiveSheet.Name = "NameList"


Range("$A$1"). Activate


Set rngName = ActiveCell





Sheets.Add


ActiveSheet.Name = "TotalData"


Sheets("NameList").Activate





Do Until rngName.Value = ""


Workbooks.Open Filename:=rngName.Value





Range("A1").Select


Range(Selection, Selection.End(xlDown)).Select


Selection.Copy


ThisWorkbook.Activate


Sheets("TotalData").Activate


Range("$A$1").Activate


If Range("$A$1").Value = "" Then


ActiveSheet. Paste


Else


Selection. End(xlDown).Select


ActiveCell. Offset(1, 0).Select


ActiveSheet.Paste


End If


Selection.End (xlDown).Select


ActiveCell. EntireRow.Delete





strname = InStrRev (rngName.Value, "\")


strname = Right (rngName.Value, Len(rngName.Value) - strname)





Workbooks (strname).Close savechanges:=False


Set rngName = rngName.Offset(1, 0)


Sheets("NameList").Activate


Loop





End Sub


No comments:

Post a Comment