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
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 have a slick piece of code which hides/unhides tables based on a certain text input in a specified cell. In Sheet1 in Book1(say), if I change the text in cell A1(say the text is apples, oranges etc), I get certain tables on sheet2 in the same book (let's call it answer sheet).
Now in a separate book, in its sheet1, I have a table with all the possible text values (apples, oranges, etc). I would like to write a code which first goes through this table, make the value in Book1.Sheets("Sheet1").Range("A1") step by step, copies the "answer sheet" from book1.
This way, the final result would be me having as many sheets as the number of products in book2 plus sheet1.
I am struggling to figure out how I get the code to reiterate through the table and keep creating new sheets and paste data.
The code I have written takes only the first element in the table from book2 and then copies it ina sheet. After that, I get the error "subscript out of range".
Sub_fruits()
Dim data_old as WorkBook
Dim data_new as Variant
Dim i As Long, LR As Long
Dim ws as Worksheet
ThisWorkbook.Sheets("Sheet1").Activate 'code is in book2
msgbox (______) 'to ask for file name 'to open book1
data_new = Application.GetOpenFIlename()
Set data_old = Workbooks.open(data_new)
Set ws = ThisWorkBook.ActiveSheet 'sheet1 in book2, the one with the table
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
For i= 1 to LR
'go through each cell in the table in book2.sheet1,
'make a1 in book1 equal to cell value and keep generating data on sheet2.book1).
data_old.Sheets("sheet1").Range("a1").Value = _
ws.Sheets("Sheet1").Range("a" & i).Value
'select data sheet from book1
data_old.Sheets("Sheet2").Select
Selection.Copy
ws.sheets("Sheet2").select
Range("a1").select
'paste it onto sheet2 in book2
ActiveSheet.Paste ()
.
.
.
I am not able to go through the table i.e. if my table is apples, oranges and bananas, I would like the code to take apples, put it in the book1, generate output, copy that and paste it in book2. And so on for other fruits in new sheets.
The code gives a subscript out of range message.
data_old here is book 1 in your code, where the table is. You need to Loop through your data to pick up each value that you're looking to copy. With an If statement, you can set the destination range of what's being copied, which is target in this example. Hope this helps.
Dim wb As Workbook
Set wb = Workbooks.Add
Dim target As Worksheet
Set target = wb.Worksheets(1)
target.Range("A1") = "Fruit"
Dim cell As Range
For Each cell In data_old.Range("A2", data_old.Range("A" & Rows.Count).End(xlUp))
If cell.Value = "apples" Then
target.Range("A" & Rows.Count).End(xlUp).Offset(1).Value = cell.Value
End If
Next cell
End Sub
I currently have multiple sheets for storing records of payments (things to be Pay and CantPay). I am trying to write a macro that will copy and paste Cells A:M on every row where column T = "Resolved" on the CantPay sheet (where the next empty row is the next row where "a" & row-number = blank) to the "Pay" sheet.
Within the sheet which i want to copy from there is data in columns A:T but N:T are not needed once the problem is resolved. So once i have copy and pasted the data within cells A:M i want to just delete the entire row. I have written some code from what i knew and looking online which isn't working. Any help would be much appreciated.
Thanks
I have tried recording a macro and writing my own but it seems the macro i have wrote is deleting row 1 which is where all my column headers are stored.
Sub MoveToPay()
Dim CantPay As Worksheet: Set CopySheet = Sheets("Can't Pay")
Dim ReadyToPay As Worksheet: Set PasteSheet = Sheets("£ Pay")
Dim lr As Long
Dim S As String
Application.ScreenUpdating = False
Columns(20).AutoFilter 1, "Resolved"
With Range("a2", Range("M" & Rows.Count).End(3))
.Copy PasteSheet.Cells(Rows.Count, 1).End(3).Offset(1)
.EntireRow.Delete
End With
Columns(20).AutoFilter
Application.ScreenUpdating = True
End Sub
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.
I have a workbook filled with text-based data on several different sheets. All the sheets use the same headings, but have different text in the columns. I would like to be able to list the information contained in the column C from all of the sheets in a single column in a new sheet.
Is there a way to get all of that data into a single column without having to copy and past from nearly 100 different sheets?
Using VBA, here is a solution that works. You just need to insert a module into your workbook and run this. F11 > Insert > Module. Copy and paste this code, and hit play.
This will create a new worksheet with whatever name you define under newSheet. Then take the contents of EVERY worksheet Row C (after header), no matter how many you have or what their name is, and add them to the new one. I could see a problem if you exceed 1,000,000 rows.. Other than that, if there are any sheets you DON'T want to perform this on, we would add them as exceptions specifically by name in the If statement.
TESTED:
Private Sub CopyAllSheetsCol()
Dim WS As Worksheet
Dim newSheet As String
Dim lastRow As Long 'Last Row on source Sheet
Dim tRow As Long 'target row
newSheet = "Compiled" 'name can be changed here
Sheets.Add.Name = newSheet
tRow = 2 'Set the target Row to 2, Set the Header Row manually
For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> newSheet Then 'Making sure we are only working with pre-existing sheets
lastRow = Sheets(WS.Name).Range("C2").End(xlDown).Row 'get last row of Column C on each Worksheet
For r = 2 To lastRow 'Loop through all rows skipping header
Sheets(newSheet).Cells(tRow, "C") = Sheets(WS.Name).Cells(r, "C") 'Copy to newSheet
tRow = tRow + 1 'Increment target row by 1
Next r
End If
Next
End Sub
edit: touched up explanation