I am attempting to loop through various workbooks and paste data into another "merge" workbook based on cell values.
Workbook A sheet contains the data I want to loop through and copy along with the adjacent two columns.
Workbook B is where I want to paste the data.
Workbook A - Column A contains numeric values. I want to copy the cells A2, B2, C2 of data only if column A2's value is between 1-299. Paste these copied cells in two workbook B- columns A, B, C starting below where the last values where pasted.
Then loop through the next row checking if its value is between 1-299.
I will then apply this to many spreadsheets, but for now I just want to get one copy and paste working so I can understand how to apply it.
How much knowledge of VBA do you have? You could try to change the following code that I've been using for something similar, although it has an input box.
Option Compare Text
Public Sub TeamReport()
Dim strFind As String
Dim i As Long, j As Long
Dim wsFind As Worksheet
Dim wsPaste As Worksheet
strFind = InputBox("Enter Team Name Here")
Set wsFind = Sheets("Complete Listing")
Set wsPaste = Sheets("Team Report")
j = 3
Worksheets("Team Report").Range("A3:DJ300").ClearContents
For i = 2 To wsFind.UsedRange.Rows.Count
If wsFind.Range("C" & i) = strFind Then
wsFind.Range(i & ":" & i).Copy Destination:=wsPaste.Range(j & ":" & j)
j = j + 1
End If
Next i
Worksheets("Team Report").Select
End Sub
It has a input box to find a specific value, but might be able to get you started.
Related
i have the following problem. I want to write a Macro, that copies three specific columns from a file "Rest.xlsx" into the original file "Schweben.xlsm". Both files are attached.
I already have the following code, which copies specific columns within the original file "Schweben.xlsm" from the table1 to a new created table2. Now i also want the macro to copy the columns K,H,D form Rest.xlsx to table2 within the "Schweben.xlsm" file into the new columns F,G,J (in that specific order). Since the files change daily, I want the macro to recognize the different lengths of the columns and always recognize all cells within the column, even if it is sometimes longer.
Sub CopyRowE()
Dim LastRowE As Long
Dim LastRowH As Long
Dim LastDataRow As Long
Dim CopyData As Long
With Tabelle1
LastRowE = .Range("E9999").End(xlUp).Row
LastRowH = .Range("H9999").End(xlUp).Row
.Range("E2:E" & LastRowE).Copy
.Range("CA1").PasteSpecial
.Range("H2:H" & LastRowH).Copy
.Range("CB1").PasteSpecial
LastDataRow = .Range("CB999999").End(xlUp).Row
.Range("CA1:CB" & LastDataRow).Copy
Sheets.Add
ActiveSheet.Range("A1").PasteSpecial
.Range("CA1:CB" & LastDataRow).ClearContents
Tabelle1.Select
.Range("A1").Select
End With
End Sub
Thanks in advance
Here is a simplified approach to copy columns of data from one sheet to another. I've matched what you asked for as best as I could understand your needs and commented the code well, so you can follow it. The important part here is the creation of a sub procedue that named "copy_column" that actually doest he copying when supplied with a source and destination cell.
Sub copyRowE()
Dim new_sheet As Worksheet
Dim source As Range
Dim dest As Range
Dim rest_sheet As Worksheet
'this code assumes that the Rest.xlsx workbook is open, if not, correct the
'following line and remove the comment character (')
'workbooks.open("c:\full\path\to\Rest.xlsx")
' copy E from tabelle1 to column A on new sheet
Set new_sheet = ThisWorkbook.Sheets.Add
'give new_sheet a name
'new_sheet.name = "Consolidated"
copy_column tabelle1.Range("E2"), new_sheet.Range("A1")
'copy H from tabelle1to column B on new sheet
copy_column tabelle1.Range("h2"), new_sheet.Range("B1")
'copy from the first sheet in rest.xlsx
Set rest_sheet = Workbooks("Rest.xlsx").Worksheets(1)
'OR copy from a particular sheet in Rest.xlsx
'Set rest_sheet = Workbooks("Rest.xlsx").Worksheets("Sheet1")
'copy column K from rest to column F on the new sheet
copy_column rest_sheet.Range("K2"), new_sheet.Range("F1")
'copy column H from rest to column G on the new sheet
copy_column rest_sheet.Range("H2"), new_sheet.Range("G1")
'copy column D from rest to column J on the new sheet
copy_column rest_sheet.Range("D2"), new_sheet.Range("J1")
End Sub
Sub copy_column(top_cell_in_source_column As Range, dest_cell As Range)
' copies data starting at top_cell_in_source_column and taking all data below it
' and pastes it beginning at dest_cell. The source and destination can be in
' different worksheets or even in different workbooks
Dim source_sheet As Worksheet
Dim source_col As Long
Set source_sheet = top_cell_in_source_column.Parent
source_col = top_cell_in_source_column.Column
Range(top_cell_in_source_column, source_sheet.Cells(source_sheet.Rows.Count, source_col).End(xlUp)).Copy dest_cell
End Sub
I would like to apply a formula to a given range.
However, the number of columns are not fixed and will vary.
Screenshots to visualise what I'm doing.
Screenshot 1: I would like for the code to auto select from column C onwards, and apply the formula in the next image. The number of columns will vary as more students attempt the quiz.
Screenshot 2: This is the formula I wish to apply to the selected range. After that, I would be able to loop through the list of teachers from B31 and below one by one, copy the range of answers for each teacher's students and paste them onto Sheets 3-6 which contain the first set of results I mentioned earlier.
Sub obtainsecond()
Sheets("Question_answers").Select
Range("C31").Select
ActiveCell.Formula2R1C1 = _
"=FILTER(R[-29]C:R[-4]C[3],ISNUMBER(SEARCH(R[-1]C,R[-30]C:R[-30]C[3])))"
End Sub
One approach to solve the problem.
This approach assumes that the last column in row 1 is the last column with a student answer.
Logic:
I check the last column and get the cell reference (i.e. $H1). Then i extract only the column letter. I take the column letter and put it in the formula you want to extend.
Code:
Option Explicit
Sub obtainsecond()
Dim QA_ws As Worksheet 'Declare the worksheet as a variable
Set QA_ws = ActiveWorkbook.Worksheets("Question_answers") 'Decide which worksheet to declare
Dim lCol As Long
Dim LastColumnLetter As String
Dim lColRange As Range
QA_ws.Activate 'Go to the worksheet
lCol = QA_ws.Cells(1, Columns.Count).End(xlToLeft).Column 'Find the last column in the worksheet by checking in row 1
Set lColRange = QA_ws.Cells(1, lCol) 'Set last column to get cell reference, i.e. $H1
'MsgBox lColRange.Address(RowAbsolute:=False) ' $H1
'https://www.exceltip.com/tips/how-to-convert-excel-column-number-to-letter.html (Formula to extract letter: =SUBSTITUTE(ADDRESS(1,B2,4),1,””))
LastColumnLetter = WorksheetFunction.Substitute(lColRange.Address(RowAbsolute:=False), "1", "") 'Get column letter
LastColumnLetter = Replace(LastColumnLetter, "$", "") 'Remove prefix
QA_ws.Range("C31").Formula2 = "=FILTER(C2:" & LastColumnLetter & "27,ISNUMBER(SEARCH(C30,C1:" & LastColumnLetter & "1)))" 'Use relative formula to print in cell (original formula: =FILTER(C2:F27,ISNUMBER(SEARCH(C30,C1:F1))))
End Sub
I have a button in Worksheet1 that when clicked it will copy the values from A20:M28 to Worksheet2.
But I want to assign which column in Worksheet2 the values from Worksheet1 will be copied to because they have different structure. Also I wanted to copy only the rows that has values but it still copied the cells without values.
I am pretty new to Macro so I'm still trying to figure things out. This is what I have so far:
Worksheet1 Structure
Worksheet2 Structure & Result when button is clicked
Sub SendTimeTable()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set ws1 = Application.ThisWorkbook
Set ws2 = Workbooks.Open("workbook2.xlsm")
'Cells A20:A28
For i = 20 To 28
'Column A to Column M
For j = 1 To 13
If ThisWorkbook.Sheets("dataSheet1").Cells(i, j).Value <> "" Then
'Now, copy what you want from worksheet1 to worksheet2:
ws1.Sheets("dataSheet1").Range("A20:M28").Copy
ws2.Sheets("dataSheet2").Range("A10").PasteSpecial Paste:=xlPasteValues
End If
Next
Next
End Sub
I'm trying to make Column E in Workbook A display the number of reports a manager has submitted in a given month in Workbook B. I want to use the COUNTA formula to count the number of non-blank cells in Column A of Workbook B, which would be equivalent to the number of submitted reports. However, there are multiple managers and each manager has their own sheet in Workbook B. For example, manager John Smith logs submitted reports in Workbook B on a sheet called "Smith". The name of the sheet in Workbook B is located in cell Q3 of Workbook A. I tried to make this work with the following code:
=COUNTA((('[Workbook B.xlsx]' & 'INDIRECT(Q3,FALSE)' & '!$A$2')),('[Workbook B.xlsx]' & 'INDIRECT(Q3,FALSE)' & '!$A$500))
Ideally, this code would count the nonblank cells from A2:A500 in Workbook B and display the number in Workbook A.
I managed to get this work by slightly changing your code. Indirect(Q3) was giving me a #ref error, so I just made it Q3 by itself with another indirect after the COUNTA and it worked.
=COUNTA(INDIRECT("'"&"[Workbook B.xlsx]"&Q3&"'!$A$1:$A$500"))
Tried my hand at making a macro for this. It might not be perfect, but hopefully it will give you a good starting point.
Sub count()
Dim cnt As Integer
Dim rng As Integer
Dim index As Integer
Dim shtName As String
shtName = Range("Q3").Value
Workbooks.Open ("C:\Path\to\WorkbookB.xlsx")
ActiveWorkbook.Sheets(shtName).Select
rng = ActiveSheet.UsedRange.Rows.count
For index = 1 To rng
If Range("A" & rng).Text <> "" Then
cnt = cnt + 1
End If
Next
ActiveWorkbook.Close False
ActiveWorkbook.Sheets("Sheet1").Activate
Range("E1").Value = cnt
End Sub
Re: Creating a master sheet from multiple sheets.
Multiple sheet description: table with many rows and columns. Columns headings are identical but rows vary. Each sheet is a date.
Task: to take a single value from a specific column (always happens to be column M). the value I want is the total of that column. Take this summed value and insert into a master sheet.
My attempt so far is:
Sub append_master_sheet()
Dim wAppend As Worksheet, wSheet As Worksheet
Dim LastRow As Long
Set wAppend = Worksheets("Master")
For Each wSheet In Worksheets
If wSheet.Name <> wAppend.Name Then
LastRow = WorksheetFunction.Max(3, wAppend.Cells(65536, 2).End(xlUp).Row)
wSheet.UsedRange.Resize(, 13).Copy Destination:=wAppend.Cells(LastRow, 2)
End If
Next wSheet
End Sub
1). it takes all 13 columns rather than only the 13th column. (I see that is because I have set it at 13 as I do not know how to cycle through the preceding columns and skip them to only return the 13th column data (and within this column return the total of the column, not the discrete line items
2) Besides returning all the data which is a problem, it actually consistently skips the final value in the column M.
Can you advise how to amend above code to
1) only return the summed value from column M in the multiple sheets (calendar dates) and insert into master.
thanks,
N
Is this what you are trying (UNTESTED)
Like I mentioned in the comment above, see THIS link on how to find a last row in a column.
I have commented the code so that you will not have a problem understanding it. But if you do, simply post back :)
Note: I am assuming that the last cell in Col M has the SUM
Option Explicit
Sub append_master_sheet()
Dim wAppend As Worksheet, wSheet As Worksheet
Dim wApLRow As Long, wShLRow As Long
Set wAppend = ThisWorkbook.Worksheets("Master")
'~~> Get the last row where the ouput should be placed
wApLRow = wAppend.Range("B" & wAppend.Rows.Count).End(xlUp).Row + 1
For Each wSheet In Worksheets
If wSheet.Name <> wAppend.Name Then
With wSheet
'~~> Fuind the last row in Col M which has the sum
wShLRow = .Range("M" & .Rows.Count).End(xlUp).Row
'~~> Copy over the values to Master Sheet
wAppend.Range("B" & wApLRow).Value = .Range("M" & wShLRow).Value
'~~> Increment the row for next output
wApLRow = wApLRow + 1
End With
End If
Next wSheet
End Sub