Within an Excel workbook I have 5 specific worksheets (different names) that I want concatenate the data from into a different worksheet (master) within the same workbook. Simply taking the data from each sheet and appending it to the bottom of the data in the "Master" sheet. Also removing blank rows if possible. Is there a macro that can do this?
There are several choices. If you only need to do this once, don't bother using a macro. Simply go to each sheet, copy the rows, move to the master sheet, scroll down to the first empty row, and paste.
Assuming that you actually need a macro for this, something like this might work:
Sub CombineSheets()
Dim Wksht As Worksheet, MasterSht As Worksheet, R As Integer
Set MasterSht = Worksheets.Add
R = 0
For Each Wksht In ThisWorkbook.Worksheets
If Not Wksht Is MasterSht Then
Wksht.UsedRange.Copy Destination:=MasterSht.Cells(R + 1, 1)
R = MasterSht.UsedRange.Rows.Count
End If
Next Wksht
End Sub
Related
I have been trying to get this to work, but I am not sure how to get it to work, any help would be appreciated.
I have 2 workbooks, workbook 1 has multiple sheets, each one labelled with a different name. Workbook 2 has one summary sheet with a column of values for each individual.
What I am trying to achieve is:
on workbook 1 check the sheet name
switch to workbook 2 and find the column with the same name. All the names are on row 6, from column I to DD. Also, each name is in 2 cells merged together, I don't know if this affects it.
Once the name on row 6 is found, I want it to go down 6 cells, and copy the value.
switch back to workbook 1 and paste it into cell B37.
Repeat this process but this time go down 7 cells, copy the value and paste it into cell B102 OF Workbook 1. I have about 30 cells to copy and past like that.
once complete repeat everything again for the next sheet on workbook 1.
Another Important issue is that, not all sheet names on workbook 1 exists on workbook 2, I have a feeling the below code will throw an error as soon as it doesn't find a match. So I would like to be able to skip the sheets on workbook 1 that it doesn't find a matching name for on workbook 2 summary sheet.
I have put the code I have below, but I keep getting the error "Method or data member not found"
Sub Measures()
Dim wb1 As Workbook
Dim Sht As Worksheet
Dim Rng, Rng2 As Range
Dim wb2 As Workbook
Dim cell As Range
Dim ws As Worksheet
Set wb1 = ThisWorkbook
Set wb2 = Workbooks("November Stream 1.xlsm")
Set Sht = wb1.Worksheets("Summary")
Set Rng = Sht.Range("A6:A" & Sht.Cells(Sht.Column.Count, "A").End(xlUp).Column)
For Each cell In Rng
Set ws = wb2.Sheets(cell.Text)
ws.Range("B37").Value = cell.Offset(6, 0).Value
ws.Range("B102").Value = cell.Offset(7, 0).Value
Next cell
End Sub
Thank you for any help!
Use case: I want to copy data from column A to Column B (where column A, B are arbitrary columns). Once the data is in Column B, I want to remove duplicate entries within column B.
Make a loop that moves data from column A to column B and then removes duplicates for each sheet in a workbook.
`Sub Copy()
For i = 1 To Sheets.Count
Worksheets(i).Range("A1:A100")
Destination:=Worksheets(i).Range("B1")
Next
End Sub
`
For testing I separated the tasks into two different Sub(). Sub Copy() is working and correctly copies my data. Sheet1 is also named "Sheet1" for my specific workbook
`Sub RemoveStuff()
Dim rng As Range
For j = 1 To Sheets.Count
Set rng = Worksheets("Sheet1").Range(Range("B1"),Range("B1").End(xlDown)).Select
rng.RemoveDuplicates Columns:=(1), Header:=xlGuess
Next
End Sub
`
My error seems to be in defining the range correctly. Each sheet will have a different number of entries to remove duplicates from. Sheet1 might have 50 rows and reduce to 6. Sheet2 could have 70 and reduce to 3. Sheet3 could have 20 rows and reduce to 12 uniques. Excel does not let you remove duplicates from range (B:B!)
How can I properly define my range so I can remove duplicates in a loop for a dynamically defined range for each sheet(sheet=tabs in workbook)?
EDIT 2-23-17
New code from Y0wE3K
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
Still does not work. If I manually select Column P before I run the macro, it works. But it only goes for the one sheet I have selected, it does not seem to execute the loop. Definitely does not automatically do each sheet, or prompt me for each one.
EDIT: 3/4
Make sure that you do not have any protected data, I also experienced issues with pivot tables but I think this may be permissions thank you for help.
Your RemoveStuff subroutine can be rewritten as:
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets ' Use Worksheets instead of Sheets,
' in case there are any Charts
'You can just select the whole column, rather than selecting
'specific rows
ws.Columns("B:B").RemoveDuplicates Columns:=1, Header:=xlGuess
Next
End Sub
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
This code will work. As a final note, please make sure you have no Protected Data, or pivot tables inside of the sheets you need to run the remove script on. For whatever reason that caused mine to fail, but running my script on the correct sheets that are unprotected worked GREAT.
I am enclosing a link with a sample spreadsheet.
What I would like to do is create multiple worksheets using the key column of "Facility", perhaps using a macro. For example, I would like to create a new worksheet called Houston and fill the worksheet with the data specific to that row. Some of the cells may end up in different locations in the new worksheet. I need to do a separate worksheet for every value in "Facility". The original that I am working on has 270 rows (270 facilities).
Does anyone have any idea how to do something like this? I am new to running and creating macros. I did create a macro that didn't work right.
Try this:
Dim wks As Worksheet
Dim lstRow As ListRow
For Each lstRow In ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").ListRows
Set wks = ThisWorkbook.Worksheets.Add
wks.Name = lstRow.Range.Cells(, 1).Value
With wks
.Range(.Cells(1, 1), .Cells(1, lstRow.Range.Columns.Count)) = lstRow.Range.Value
End With
Next
Set wks = Nothing
Assumptions:
Worksheet name where data resides is called Sheet1
Table containing data is a ListObject (e.g., convert your data range into an Excel table)
ListObject name is Table1
Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub
Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")
Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.
You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.
Cells(4, x) = Application.WorksheetFunction.COUNTA(Workbooks(""DB_Report.xls"").Sheets(x).Range(A:A))
I am trying to get the above function to work.
I am calling the script from the workbook DB_report.xls
This creates a new workbook ("month") and starts filling in the values.
What I am trying to get to is where
cell 4,1 in months has the counta of sheet 1 from DB_report
cell 4,2 in months has the counta of sheet 2 from DB_report
Can anyone reword the line above so when "months is the active work sheet I can call counta from DB_Report
The line before this is
NameSH = Workbooks("DB_Report.xls").Sheets(x).Name and this works fine and returns the name of work sheet x
Thanks
Aaron
Ok for a bit further explicanation
the steps I want to do go some thing like this
select workbook months.xls
select sheet(1)
cell (x,y) = counta( of range A:A , in worksheet("DB_Report") of worksheet (DB_report.xls)
Now I know
Cells(4, x) = Application.WorksheetFunction.COUNTA(sheet(3).range(a:A)
will work with in the active work sheet. So if the active sheet is sheet 1 then that would count up he numbe of cells in sheet 3 of the same workbook. I wanted to know if as well as refrenced sheet and cells in the function I can also refrence a workbook by name.
of course i could swqap to book "DB_Report" save the value to a varible and then swap back to book "Month" and copy it to the cell.
or could I do workbook("month").sheet(y).cells(a,b) = Application.WorksheetFunction.COUNTA(sheet(3).range(a:A)
while in workbook "month"
so really what i need is how do you refrence workbook,sheet and cells all with in a function?
I don't think this is exactly what you were trying to do, but it comes close and is a bit more generalized. It counts up the worksheets in what would be DB_Report.xls and uses that to specify that number of cells in months.xls
If you are running the macro from the DB_Report.xls you don't need to specify anything about that workbook or sheets.
Sub counts()
Dim sheetcounts As Integer
Dim countas() As Integer
Dim index As Integer
Dim wksht As Worksheet
Dim newbook As Workbook
sheetcounts = ActiveWorkbook.Sheets.Count
ReDim countas(sheetcounts)
For Each wksht In ActiveWorkbook.Sheets
countas(index) = Application.WorksheetFunction.CountA(wksht.Range("A:A"))
index = index + 1
Next
Set newbook = Workbooks.Add
newbook.Activate
newbook.ActiveSheet.Range(Cells(4, 1), Cells(4, sheetcounts)) = countas
newbook.SaveAs ("months.xls")
End Sub
It will require any error checking or verification that you need to put into it.
Hi Cheers for the comments, but i finaly worked out what the problem was.
it was simple really I was just missing some formatting
the line below works correctly
cell(x,y) = Application.WorksheetFunction.CountA(Workbooks("DB_Report.xls").Sheets(x).Range("A:A"))