Union multiple excel sheets. (Paste underneath each other) - vba

What would be the cleverst way of copy and pasting Excel-Tables from multiple files to one single file. So espacially how do I determine the Range of the used Rows for the copy and paste within the makro?

If this is a one time operation, probably the quickest way would be to activate the office clipboard (arrow in bottom right corner on Home tab). This allows up to 24 separate ranges to be collected and pasted below one another.
Assuming data is in one workbook and starts in row 2 on each sheet, as in the example below, you can:
Select all the tabs
Select all the rows on the first sheet
Press Ctrl+C, Ctrl+Page Down, repeatedly to copy all the data
Select a new sheet and click Paste All
Note that only the used range is copied so you can copy whole sheet ranges instead of needing to locate the last cell on each sheet.

If you really mean Tables you can reference them using the ListObjects collection.
Try this (code located in destination workbook)
This code copies all source tables as separate tables with a blank row between. If you want to merge the data into a single table you will need to copy lo.DataBodyRange rather than lo.Range and handle the header row and conversion to a table separetly.
Sub CopyTables()
Dim wbFrom As Workbook
Dim shFrom As Worksheet
Dim shTo As Worksheet
Dim lo As ListObject
Dim clTo As Range
' Setup Destination for copied tables
Set shTo = ThisWorkbook.Worksheets("DestinationSheet") ' <-- change name to your destination sheet name
' remove any existing data
shTo.UsedRange.EntireRow.Delete
Set clTo = shTo.Cells(1, 1)
' Loop through open workbooks
For Each wbFrom In Application.Workbooks
' except destination wb
If wbFrom.Name <> ThisWorkbook.Name Then
' loop through all sheets
For Each shFrom In wbFrom.Worksheets
' loop through all tables on sheet
For Each lo In shFrom.ListObjects
lo.Range.Copy clTo
' offset to next paste location, leave one empty row between tables
Set clTo = clTo.Offset(lo.ListRows.Count + 2, 0)
Next
Next
End If
Next
End Sub
Alternative inner For loop to paste to a single range
For Each lo In shFrom.ListObjects
lo.DataBodyRange.Copy clTo
Set clTo = clTo.Offset(lo.ListRows.Count, 0)
Next

Related

vba code to insert dynamic amt of rows

need to modify this code which currently pastes the current region to the specified page, to instead read the # of rows used on the sheet that is called, and then insert that number of rows before pasting the data. having issues if the sheet called is > 187 rows it will paste over existing data that it should not touch. need it to then reset when a new sheet is called to the pasting area
Dim wkSht As Worksheet
For Each wkSht In Sheets
'sheet6 is the DashboardMain sheet
If Sheet6.Range("E3").Value = wkSht.Name Then
wkSht.Range("A1").CurrentRegion.Copy Destination:=Sheet6.Range("A12")
End If
Next

VBA Code for Conditional Copying of Columns Not Adjacent to each other

Project Master
In MS Excel using VBA, I would like some help on conditional copying between worksheets within the same workbook. As per the attached image, I have a master list of projects on the worksheet "Master". For all the projects that have a "yes" in column I (Defect), I would like to copy the values in columns A (Works Package Issue Date), B (Project No.), E (City) and H (Contract Value) to another worksheet "Defects", within the same workbook.
Can you please provide a coding which could:
a) collapse all the rows so there is no blank rows in "Defects" worksheet; and
b) leave all the rows so if the "Defect" column has a "No", the relevant row from the "Master" worksheet is copied as a blank row in the "Defect" worksheet,
if possible.
Please help me with the coding - I have very basic knowledge of macros, and in a process of learning how to code.
Thanks & Regards, CK
Sub CopyValues()
'Declare variables
'Declare sheet variables
Dim Masterws as Worksheet
Dim Defectws as worksheet
'Declare counter variables
Dim I as Integer
Dim n as Integer
'Set value of sheet variables
Set Masterws=ThisWorkbook.Sheets("Master")
Set Defectws=ThisWorkbook.Sheets("Defects")
'Set value of counter to track first available row on Defects sheet
n=1
'Start a For loop to check each row on Master sheet, starting with row 2
For I = 2 to WorksheetFunction.CountA(Masterws.Columns.EntireColumn(1))
'If the cells in row I, column I have a value of, "Yes," then execute some code. If not, continue on.
If Cells(I, "I").value= "Yes" Then
'Set the value of cells in row n of the Defects sheet to the corresponding values of row I in the Master sheet. If n is replaced with I, then the value of cells in row I on Defects will be set to the values of Row I on Master, leaving blank rows where no, "Yes," was found because no copying took place.
Defectws.Cells(n,"A").Value=Masterws.cells(I,"A")
Defectws.Cells(n,"B").Value=Masterws.cells(I,"B")
Defectws.Cells(n,"C").Value=Masterws.cells(I,"E")
Defectws.Cells(n,"D").Value=Masterws.cells(I,"H")
'Add 1 to the n counter. The next time a row is found in the Master sheet with, "Yes," it will be written to the next available row down on the Defects sheet.
n=n+1
End If
'End of the For loop. Move on to the next row on Master sheet
Next
End Sub

How can I copy & paste entire rows with distinct values to a new sheet on varying cell ranges?

I know there's many StackOverlow Q&A's on copying & pasting from a cell value in VBA. However, I can't seem to make it work for my own project. I want to copy the entire row(s) if it matches the Distinct Store# (non incremental) in Column H into a new sheet (in this code below, "Sheet1") which already has a template layout where I copy/paste the values. The template looks the same on every sheet before any data is filled in, except the first 2 tabs which have the data ("Appointments" and "Invoices").
I came up with the VBA below, but here's the catch- the cell# that it pastes the row(s) (in the code below, "A10") changes based on the Store #. This is because I am copying rows from the 1st sheet ("Appointments") in the workbook from the distinct Store#, then deleting the empty rows above the area where the 2nd sheet ("Invoices") data goes. Some stores may return 10 rows or none at all. The Case, which is the Store #, is currently manually put in one by one. Should it be an array instead?
Anyway...I was hoping to automate the copying/pasting and loop for each store to their sheet. Maybe I'm going about this wrong, but would anyone be kind enough to suggest how to solve my error code "Method or data member not found." as well as provide any suggestions on making my code better for a loop for filtered cell copying to different spots for each sheet.
Simple explanation of my step by step process:
1.Filter Store # from "Appointments" sheet.
2. Copy all rows for that store and paste into a new sheet with template named "Sheet1" in B3.
3. Filter Store # from "Invoices" sheet.
4. Copy all rows for that store and paste into the previously made sheet named "Sheet" under the above rows. (Some stores do not have invoices, so this section is blank/NULL). Paste destination cell for "Invoices" will be different for each store# depending on how many rows they get from the "Appointments" sheet (could be A10 or A25).
5. LOOP- Next store #, next sheet (sheet2).
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbooks
Dim sheet1 As Worksheets
Dim sheet2 As Worksheets
Set book = Workbooks("SampleWorkbookName")
Set sheet1 = Worksheets("AllInvoices")
Set sheet2 = Worksheets("Sheet1")
For Each i In sheet1.Range("H:H")
Select Case i.Value
Case 1243
sheet2.Range("A10").End(xlUp).Offset(1, 0).EntireRow.Value = i.EntireRow.Value
Case Else
End Select
Next i
End Sub
Try this:
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbook
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set book = Workbooks("SampleWorkbookName.xlsx")
Set sheet1 = book.Worksheets("AllInvoices")
Set sheet2 = book.Worksheets("Sheet1")
'iterate only thorugh those cells in H that have data, not all 1.04 million
For Each i In sheet1.Range("H1", sheet1.Range("H" & sheet1.Rows.Count).End(xlUp))
Select Case i.Value
Case 1243,"1243"
sheet2.Rows(sheet2.Range("A10000").End(xlUp).Offset(1, 0).Row).Value = sheet1.Rows(i.Row).Value
Case Else
End Select
Next i
End Sub

how to create macro because values to be copy in DropDown are increasing always. and I have to give Source to Create List in Data Validation

I want to make drop Down List in sheet2 which contains values from sheet1 column. I have tried this code.
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
columns in sheet1 are changing oftenly. so needs to create Dynamic VBA Macro code.
Please guide me for this query.
For your case, I don't think that you need a macro to manage the drop down list but perhaps data validation will do.
Create a new worksheet,
I got a worksheet contain the following data at column A
At the worksheet that i want the dropdownlist, i just highlight the cell and click on the data validation button at data ribbon
In the data validation, create the following setting
Click on the ok button and the list will be created
Since in the columns in the worksheet(source) keep on changing, you need write the macro to copy the entire needed column exclude the header of the column to next worksheet(e.g. worksheet that create the dropdown list).
Edited: Code to detect the criteria column and copy the column
Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Dim MyWorksheet2 As Worksheet
Dim WantedColumn As Long
Dim ColumnPointer As Long
Sub copyCriteria()
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("Sheet6")
Set MyWorksheet2 = MyWorkbook.Sheets("Sheet5")
For ColumnPointer = 1 To MyWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
If MyWorksheet.Cells(1, ColumnPointer).Value = "ColumnE" Then
MyWorksheet.Columns(ColumnPointer).Copy
MyWorksheet2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
MyWorksheet2.Rows("1:1").Delete Shift:=xlUp
End If
Next
End Sub
What you are trying to do can be done with a simple named range and Data Validation to use that Name. If you have not heard of Dynamic Ranges, then you should read on.
If Sheet1 only has the 1 column for the DropDown list via Data Validation, you should use a Named Range instead of a fixed Range. But this named range is dynamic (by using formula)! See OFFSET usage.
Lets say Sheet1 is like below:
Lets say the name to be used is MyList, then in Excel click Name Manager in Formulas tab, and place in below as the Range Refers to:
=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A))
Now in Sheet2, the Data Validation is placed on B2, when setting it up, once you put in the source to =MyList, Excel highlights it:
Then the drop down list worked:
Now if you add data to your list (Column A on Sheet 1), the MyList automatically expands and hence your DataValidation drop down list!
Note the list will go up to the first blank cell in Column A, so NO GAPS!
Enjoy!

Concatenate data from multiple Excel sheets into one Excel sheet

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