I am using the code below to copy tables from another workbook into my "extract" workbook.
This code works, but I need to specify which table I am looking for. I was hoping to use a program that could find the table in the specified sheet, or all the cells which contain data and copy those cells.
Sub SelectingTable()
Set Extract = Workbooks("Test1")
Set Pastdue = Workbooks("Past Due Data")
'Look for Past Due table
Pastdue.Activate
Pastdue.Worksheets("Sheet1").ListObjects("Table4").DataBodyRange.Copy
'Paste table in extract
Extract.Activate
Extract.Paste Destination:=Worksheets("Sheet1").Range("B10")
End Sub
In this code I am basically looking for table4 in the Past Due workbook and pasting it in my Extract. I am new to excel vba so I hope you could help me. Thanks.
Hmm do you want to extract a particular table or copy all the tables? For the latter you can just loop through all the tables
Sub SelectingTable()
Dim tbl as listObject
Set Extract = Workbooks("Test1")
Set Pastdue = Workbooks("Past Due Data")
'Loop through table
pasteRow = 1 'set which row to paste
For each tbl in Pastdue.Worksheets("Sheet1").ListObjects
rowsCount = tbl.range.rows.count - 1 'minus header
tbl.DataBodyRange.Copy extract.worksheets("Sheet1").cells(pasteRow,1)
pasteRow = rowsCount +3
next tbl
End Sub
Related
I have an Excel sheet that has a table in range A4:BD4 (this is the first row of the data. I want to clear the data but leave the table intact. I do not know how many rows are of data are in the table, it will vary.
The table itself has a few more columns but I do not want to remove the data from them just from A thru BD. BE for instance needs to hold the data.
Here is code that removes all the data from all the columns:
For Each mySheet In wb.Sheets
For Each myTable In mySheet.ListObjects
myTable.DataBodyRange.ClearContents
Next myTable
Next mySheet
Thanks for any help with this.
This should work; you can use offset and resize together to skip over whichever areas you want to leave intact:
Sub ResetTables()
Dim wb As Workbook
Dim mySheet As Worksheet
Dim tbl As ListObject
Set wb = ThisWorkbook
For Each mySheet In wb.Sheets
For Each tbl In mySheet.ListObjects
With tbl.DataBodyRange.Offset(0, 0)
.Resize(.Rows.Count, .Columns.Count - 1).Columns.ClearContents
End With
Next tbl
Next mySheet
End Sub
I think you may find this resource helpful if you want additional help:
http://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
I have a Data Validation list in cell T3 in Sheet3 of my workbook. The list contains location names. In sheet1 of my workbook I have all the data for all locations in tables next to each other, e.g
location 1|date|score|percentage|target| |location 2|date|score|percentage|target| etc....
I am looking to select a location from the drop down list and that will copy in the relevant table to sheet3. So you just select a location and can see the data. I'm wondering if the best way to go about this is formulas or to use VBA (my experience with using drop down lists in VBA is limited). Here is something that I am currently working on but it is incomplete at the moment and still leads to the question of 'is there a faster way to do this in VBA'. Any help or advice is greatly appreciated! (my validation list is called List1)
=IF(ISNUMBER(A2),IF(ISERROR(VLOOKUP(A2,Sheet1!$A:$EG,MATCH(List1,Sheet1!$1:$1,0),FALSE)),0),"")
The idea is that i could have a table of formulas so depending on the list value, different data would appear.
This isn't complete but it should get you started / give you some ideas
Sub CopyTable()
Dim colNo, lastRow As Integer
Dim ws1, ws3 As Worksheet
Set ws1 = Sheets("Sheet1") ' assign the worksheet variables
Set ws3 = Sheets("Sheet3")
colNo = Application.Match(ws1.Range("T1"), ws1.Range("A1:R1")) ' work out which column the required table starts in
lastRow = ws1.Cells(10000, colNo).End(xlUp).Row ' work out the last row of the table
ws1.Range(ws1.Cells(1, colNo), ws1.Cells(lastRow, colNo + 4)).Copy ws3.Range("A1") ' copy the table
End Sub
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
I want to copy data from one table to another, from one workbook to another.
I know the table names, they are identical.
The source table has an unknown number of data rows plus an unknown number of empty rows. The destination table (same name, same sheet) has only empty rows, but not necessarily the same overall number of rows as the origin.
i know i can do something like
sourceBook.Activate
ActiveSheet.ListObjects(knownTableName).DataBodyRange.Select
Selection.Copy
destinationBook.Activate
ActiveSheet.ListObjects(knownTableName).DataBodyRange.Select
ActiveSheet.Paste
However there are a number of problems:
The table is not on the activeSheet. How do i find the sheet that the table is on? or is there a better way to reference it (ideally without having to find the sheet first)?
I know .Activate and Selection.Copy is slow and bad. How can i do it better?
How do i find the "used" data range of both tables without looping through the table rows?
Is it possible to copy the data row by row (so that only non empty rows are copied)? ideally, i would like to just insert all non-empty source rows to the destination table and subsequently delete all empty rows in the destination table
To answer question 2:
Dim loSource as ListObject
Dim loDestination as ListObject
Set loSource = ... 'To do
Set loDestination = ... 'To do
loDestination.Range(2,1).Resize(loSource.ListRows.Count, loSource.ListColumns.Count).Value = loSource.DataBodyRange.Value
Answer to your first problem (maybe you could break your question up and ask different questions for different problems)
Since ListObjects is a child of WorkSheet -- I don't see of any way to avoid iterating through the workbooks looking for the sheet containing the table. Something like this:
Function FindTable(WB As Workbook, TableName As String) As String
Dim ws As Worksheet
Dim wsName As String
On Error Resume Next
For Each ws In WB.Sheets
wsName = ws.ListObjects(TableName).Parent.Name
Next
If Len(wsName) = 0 Then
FindTable = "Table Not Found"
Else
FindTable = wsName
End If
End Function
To test it I created a table named "Hidden Table" and put it on sheet 3. Then I ran this:
Sub test()
Debug.Print FindTable(ActiveWorkbook, "Hidden Table")
Debug.Print FindTable(ActiveWorkbook, "Nonexistant Table")
End Sub
Which printed:
Sheet3
Table Not Found
Ok Hi everybody,
I've been looking into this and trying to figure it out for a couple days now. I've found things close but nothing matches what I need.
I have 13 departments here and each department has a sheet with issues that need to be resolved. What I need is when each of those departments updates their excel sheet with an issue it updates on the master list (which is in the same workbook). Since people are constantly deleting and adding the formula would need to stay.
Would it be easier to have them enter the data on the master sheet and have that go into the individual files? If so how would I even do that? Thanks in advance. I'm trying to see if an advance filter or something would work but can't get it just right.
You will need to adjust the names in my code but if you paste this code in each of your department sheets (not the master list) you should get your desired result:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim xlws As Excel.Worksheet
Set xlws = ActiveSheet
For i = 1 To 13
If IsEmpty(xlws.Cells(2, i).Value) = True Then
Exit Sub
End If
Next
Dim xlwsMaster As Excel.Worksheet
Set xlwsMaster = ActiveWorkbook.Worksheets("master list")
i = 1
Do While IsEmpty(xlwsMaster.Range("A" & i).Value) = False
i = i + 1
Loop
xlws.Range("A2:M2").Copy
xlwsMaster.Range("A" & i).PasteSpecial xlPasteAll
xlws.Range("A2:M2").Clear
End Sub
every time there is a change on one of those sheets it will check to see if all the values of a through m are filled if they are it copies a2:m2 and pastes it at the first empty row on the master list and then clears a2:m2 on the sheet in question