Dim i, last As Integer
last = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To last
If Cells(i, 1) <> "" Then
Range("A1:C").Select
Selection.Copy
Sheets("Sheet2").Select
Application.Run "updatecc"
Range("A1:c").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Application.Run "updatecc"
End If
Next i
End Sub
Help needed here, I want to add cells dependent upon data in cells of sheet1 to sheet2.
It is copying only first a1:c1 values.
I need to copy from sheet1 and paste it in sheet2 and generate cells.
Replace the first Range("A1:C").Select by Range(Cells(i,1),Cells(i,3))
This will select columns A to C of the row that you are checking.
Related
I am quite new to VBA, hence unable to understand the scripts at this moment.
I tried recording a macro and it does quite a good job. However, it's not dynamic.
Here is my use case:
I have an excel workbook and it has two sheets named "Sheet1" & "FinalData". All I want to do is copy the data from a specific cell range of let's say C2:P2 from "sheet1" and append it to the "FinalData" sheet.
Basically, find the last empty row and paste the data there. Below is my recorded piece of vba code that indicates this function.
Can anyone help me with fixing the below code or sharing a new code, please? I will be grateful to you.
Thanks!
Application.CutCopyMode = False
Range("C2").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("FinalData").Select
Range("A2").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Try this code, to select the last empty row, just sum + 1 to the total used rows
Application.CutCopyMode = False
Range("C2").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("FinalData").Select
Cells(Sheets("FinalData").UsedRange.Rows.Count + 1, 1).Select ' Select last empty row
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sub copyData()
Dim sheet1 As Worksheet
Dim finalDataSheet As Worksheet
Set sheet1 = Sheets("Sheet1")
Set finalDataSheet = Sheets("FinalData")
'Get the last column based on the second row.
lastcolumn = sheet1.Cells(2, Columns.Count).End(xlToLeft).Column
'Get last row based on column C.
lastrow = sheet1.Cells(Rows.Count, 3).End(xlUp).Row
'Option A:
'Only transfer row 2 with dynamic columns from C to end column.
finalDataSheet.Range(finalDataSheet.Cells(2, 3), finalDataSheet.Cells(2,
lastcolumn)).Value = _
sheet1.Range(sheet1.Cells(2, 3), sheet1.Cells(2, lastcolumn)).Value
'Option B:
'Transfer entire dynamic table structure starting at c2.
'Get the values from sheet 1 data range and copy values over to final data
sheet into the same position.
finalDataSheet.Range(finalDataSheet.Cells(2, 3),
finalDataSheet.Cells(lastrow, lastcolumn)).Value = _
sheet1.Range(sheet1.Cells(2, 3), sheet1.Cells(lastrow, lastcolumn)).Value
End Sub
My file has four sheets.
From all of them, I want to copy and paste column A (from A:10) (which contains a concat formula) when some other rows are populated and then save into a csv.
All rows from A10 onwards have the concat formula which is then filled in depending on the other columns (the same applies for the other sheets).
I have it currently creating sheet1, and pasting there, then saving as a csv.
However, from the first sheet it looks at, it takes only the first line (but the second line - J11 (and so A11) are populated.
In the other sheets, it is copy and pasting the 2 rows that are populated, but also all the other rows as there are formulas there that return zero.
As I have the .End(xlDown) and technically all the other rows are populated.
I tried an IF statement for the last sheet only as a test, and currently it only copies the first populated line, and not the second (but at least it also doesn't copy all the other cells with zero).
Essentially, for each sheet I'd like to loop through with for example E10 is populated, copy and paste A10 into Sheet1, etc., if E10 is not zero.
Sub Output_test1()
'
' Output_test1 Macro
'
'
Sheets("Create").Select
Range("A10", Range("J10").End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add.Name = "Sheet1"
Sheets("Sheet1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Assign").Select
Range("A10", Range("E10").End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Date & Time").Select
Range("A10", Range("E10").End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Event Type").Select
Dim rg As Range
For Each rg In Range("E10").End(xlDown)
If rg.Value > 0 Then
End If
Range("A10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
Next
Sheets("Sheet1").Move
myTime = Format(Now, ("dd.mm.yy"))
ChDir "C:\Users\"
ActiveWorkbook.SaveAs Filename:= _
"Recruit_" & myTime & ".csv", FileFormat:=xlCSVUTF8, _
CreateBackup:=False
End Sub
There is no loop in your code not are you checking any values. I assumed you need to check column J in the source sheet and copy column A to the destination sheet.
This is a possible starting point:
k = 1
For i = 10 to 20
If Sheets("Source").Range("J" & i).Value = 0 then
Sheets("Destination").Range("A" & k).Value = Sheets("Source").Range("A" & i).Value
k = k + 1
End if
Next i
This only copies the value, not the formula. Not sure how much to explain, comment on the answer if any questions
I want to merge the first and the last row using the =cell1&cell2 function of the table but was unable to as the number of row can be dynamic.
Tried using the relative distance using ctrl+up but to no avail.
Ideally a VBA code where I can use the "&" function to merge the most top and last row of the table then paste special on top as text
Sub Macro9()
ActiveCell.FormulaR1C1 = "=R[-9]C&R[-2]C"
ActiveCell.Select
Selection.Copy
Selection.End(xlUp).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(2, 0).Range("A1").Select
Range(Selection, Selection.End(xlToLeft)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
If I understand correctly , what you want is a way to address the last cell in a column.
You can do this as follows:
Set sht = Sheets("main")
column = 1
lastRow = sht.Cells(sht.Rows.Count, column).End(xlUp).Row
Set lastCell = sht.Cells(lastRow, column)
lastCell is a range variable referencing the last cell in the column specified by the column variable. I explicitly referenced the sheet to avoid problems with active sheets.
Sub MergeCells()
col = 1 // column A
lastRow = Cells(Rows.Count, 1).End(xlUp).row
Mcell = Cells(1, col) & Cells(lastRow, col)
End Sub
I have to transpose rows to columns in excel using vba and the data is of around 500000.
The problem is that the data is not regular and is consistent.
Like there will be 4 rows then a blank then it can be three rows or one as well.
I want to transpose the group of data separated by a blank cell to be transposed to the the respective column in-front of the first entry.
Sub Transpose()
' Transpose Macro
' Keyboard Shortcut: Ctrl+Shift+T
Do Until IsEmpty(ActiveCell.Value)
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Loop
End Sub
I used this code but the problem is that it is skipping the data which is present in the single row.
Then this should do it, beware that I'm assuming where your data is and where is going to get paste, don't forget to change that:
Option Explicit
Sub Transpose()
Dim LastRow As Long 'last row on the sheet
Dim TransposeRow As Long 'row where we transpose
Dim x As Long 'columns
Dim C As Range 'faster looping through cells with For Each C in range
With ThisWorkbook.Sheets("MySheet") 'change this to your sheet
'To assign the last row im gonna assume your data is in column A or 1(B would be 2 and so...)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Last row with data
TransposeRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 'on column B will be pasting the data
x = 2 'initialize x being 2 as for B column
For Each C In .Range("A2:A" & LastRow)
If C = vbNullString Then 'in case the cell is blank we jump a row
TransposeRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 ' recalculate row for transposing data
x = 2 'reinitialize column counter
Else
.Cells(TransposeRow, x) = C 'we copy the value to the row and column empty
x = x + 1 'add 1 column
End If
Next C
End With
End Sub
I have edited your code to show an approach that can work for you. You need to add a condition for one cell data.
Sub Transpose2()
' Transpose Macro
' Keyboard Shortcut: Ctrl+Shift+T
Do Until IsEmpty(ActiveCell.Value)
If IsEmpty(ActiveCell.Offset(1, 0).Value) Then
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
ActiveCell.Offset(0, -1).Range("A1").Select
Else
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
End If
Application.CutCopyMode = False
Selection.End(xlDown).Select
Loop
End Sub
Note: Using select is not generally a good idea. An example of cutting down select would be:
Sub Transpose3()
' Transpose Macro
' Keyboard Shortcut: Ctrl+Shift+T
Do Until IsEmpty(ActiveCell.Value)
If IsEmpty(ActiveCell.Offset(1, 0).Value) Then
ActiveCell.Copy ActiveCell.Offset(0, 1)
Else
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
ActiveCell.Offset(0, 1).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
ActiveCell.Offset(0, -1).Range("A1").End(xlDown).Select
End If
Application.CutCopyMode = False
Selection.End(xlDown).Select
Loop
End Sub
I have 2 workbooks Say Workbook 1 and workbook 2. Need to put a filter in Workbook 2 with filter "INTDN" in column G and copy column "O" and column "J" in workbook 1, column "B" and Column "I" respectively.
Can any one give a VBA code for this?
Workbook and worksheet name can be anything depending on the source however format will be same always.
Some more information for your reference:-
Workbook 2
Put a filter in Row 12 column G :- "INTDN"
Workbook 1
Paste copied data from column "O" to cell B25 downwards.
Paste copied data from column "J" to cell I25 downwards.
I will then assign this Macro to every worksheet I need this to work.
I am a novice in VBA. Appreciate your assistance.
This is what I could write:-
Sub CopyData()
'
' CopyData Macro
'
'
Windows("Book1 (8).xlsx").Activate
Range("A12").Select
Selection.AutoFilter
Range("G12").Select
ActiveSheet.Range("$A$12:$AV$72").AutoFilter Field:=7, Criteria1:="INTDV"
Range("O35").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("DebitNotes.xlsm").Activate
ActiveSheet.Paste
Range("I25").Select
Windows("Book1 (8).xlsx").Activate
Range("J35").Select
Range(Selection, Selection.End(xlDown)).Select
Range("J35:J72").Select
Application.CutCopyMode = False
Selection.Copy
Windows("DebitNotes.xlsm").Activate
ActiveSheet.Paste
End Sub
This code will copy values from column O on sheet1 and copy to end of column P in sheet2.
I also made it generic so it can be used for any columns and sheets.
Sub Test()
Call CopyColumn("Sheet1", "O", "Sheet2", "P")
End Sub
Function CopyColumn(sourceSheetName As String, sourceColIndex As String, destSheetName As String, destColIndex As String)
Dim lastRowSource As Integer: lastRowSource = Sheets(sourceSheetName).Cells(Rows.Count, sourceColIndex).End(xlUp).Row
Dim lastRowDest As Integer: lastRowDest = Sheets(destSheetName).Cells(Rows.Count, destColIndex).End(xlUp).Row
Sheets(sourceSheetName).Range(sourceColIndex & "1:" & sourceColIndex & lastRowSource).Copy Destination:=Sheets(destSheetName).Range(destColIndex & lastRowDest + 1)
End Function
I have this final code which is working fine. Only problem is that I want this code to work for any open workbook>worksheet. Name of the workbook or worksheet can be anything. It is not in my control.
Sub CopyPaste()
'
' CopyPaste Macro
'
'
Range("H11").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("H12").Select
Windows("Data1.xlsx").Activate
Range("A12").Select
Selection.AutoFilter
Range("G12").Select
ActiveSheet.Range("A12").AutoFilter Field:=7, Criteria1:="INTDV"
Range("O35").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("DebitNotes.xlsm").Activate
Range("B25").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I25").Select
Windows("Data1.xlsx").Activate
Range("J35").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("DebitNotes.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I207").Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.ClearContents
Range("I207").Select
Columns("I:I").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Range("I207").Select
End Sub