This is a difficult Visual Basic question so I’m not sure if anybody in this forum will be able help. But it’s worth a try.
I wrote a program in Visual Basic to be used as a macro in Excel.
In the macro, I am taking data in sheet1 (FINAL) and copying & pasting the values into sheet2 (Data). My data range in sheet1 has many blank cells so I wanted to create a program that will only paste rows with values (versus rows with only blank cells).
My program right now modifies my data range in sheet 1 before pasting into sheet2 and I don’t want that……..my formatting gets all screwed up as a result too. Instead I want the data in my sheet1 to stay completely the same and the blank rows to be removed in the paste action going into sheet2.
My data in sheet1 begins at Column AL and proceeds to Column CD.
It’s very important that the integrity of the rows be maintained. I don’t want blank cells to be erased during the paste, but rather BLANK ROWS from the range to be erased during the paste. So if there is a row between columns AL and CD that has even just one data point, the row as a whole must be maintained in the paste. But for any rows between columns AL and CD that are completely blank, they need to be removed in the paste action going into sheet2.
My existing program is below. Any help would be greatly appreciated.
Dim ws As Worksheet
Set ws1 = Worksheets("FINAL")
Set ws2 = Worksheets("Data")
With ws1.UsedRange
lastcolumn = .Cells(1, 1).Column + .Columns.Count - 1
lastrow = .Cells(1, 1).Row + .Rows.Count - 1
End With
ws1.Range(Cells(1, 38), Cells(lastrow, lastcolumn)).AutoFilter field:=1, Criteria1:="<>"
ws1.Range(Cells(1, 38), Cells(lastrow, lastcolumn)).Copy
ws2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
This is a difficult Visual Basic question so I’m not sure if anybody in this forum will be able help. But it’s worth a try.
Hope it was worth a try :P
Is this what you are trying?
Sub Sample()
Dim wsInput As Worksheet, wsOutput As Worksheet
Dim rng As Range, CellsTobeCopied As Range, aCell As Range
'~~> Sheet which has range that you want to copy
Set wsInput = ThisWorkbook.Sheets("Sheet1")
'~~> Set range that you would like to copy
Set rng = wsInput.Range("A1:E4")
'~~> Output Sheet where you want to paste
Set wsOutput = ThisWorkbook.Sheets("Sheet2")
For Each aCell In rng.Rows
'~~> Check if the entire row is blank
If Application.WorksheetFunction.CountA(aCell) <> 0 Then
'~~> Construct your range to be copied
If CellsTobeCopied Is Nothing Then
Set CellsTobeCopied = aCell
Else
Set CellsTobeCopied = Union(CellsTobeCopied, aCell)
End If
End If
Next
'~~> Copy final range
If Not CellsTobeCopied Is Nothing Then
CellsTobeCopied.Copy
'~~> In case you want to preserve formats
wsOutput.Range("A1").PasteSpecial xlPasteAll
'~~> If you wan tto paste values then comment the above and use this
' CellsTobeCopied.Copy wsOutput.Range("A1")
End If
End Sub
Screenshot
Related
I have a workbook that serves as a database with an Input page. I want to make Column A dynamic, which will update header rows on all pages of the worksheet. I have created a macro that copies these header names from Column A on the Input Sheet, and pastes these values as headers on the next sheet. Once these header rows are labeled they are copied on Sheet 2 a second time so they can be pasted as additional header rows to the right of the previously pasted values. The reason is because they are values monitored at Start and Stop times, which will have different data stored at each time. Also, I would like these header rows to have medium weight borders around them. I have drafted the following code, but it only works partially correct by copying the first set as expected, however the second copy part does not work as well. I was hoping to create a template sheet in the document, which would have Date, Start Time, Space, End time. This would mean the copy rows would need to be inserted after Start Time and again after End time in a dynamic manner so this list could grow. Please see my attached code and thank you so much for any help.
Sub CopyData2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim wb As Workbook
Dim lRow As Long
Dim lCol1 As Long
Dim lCol2 As Long
Dim cRange As Range
Dim iCell As Range
Dim iRange As Range
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
lRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lCol1 = ws2.Cells(12, Columns.Count).End(xlToLeft).Column
lCol2 = ws2.Cells(3, Columns.Count).End(xlToLeft).Column
ws1.Range("A13:A" & lRow).Copy
ws2.Range("C3").PasteSpecial xlPasteValues, Transpose:=True
Set cRange = ws2.Range(("C3"), ws2.Range("C3").End(xlToRight))
cRange.Select
cRange.Copy
ws2.Cells(3, lCol2).PasteSpecial xlPasteValues
End Sub
I'd suggest replacing the last 4 lines with those below
With ws2.Range(("C3"), ws2.Range("C3").End(xlToRight))
ws2.Cells(3, lCol2).Resize(.Rows.Count,.Columns.Count).Value2 = .Value2
End With
in order to avoid both the Select, and redundant use of the clipboard.
I don't understand what you're trying to do with the Start/Stop times but the try removing cRange.Select to fix the 2nd Copy/Paste
I am a new programmer when it comes to VBA and I am writing a code that scans multiple Criteria and then copy and pastes to another sheet. I have 2 Sheets right now Sheet1 and Sheet2, I will first need to scan J9 on Sheet1 and then lookup Sheet2 for Sheet1’s J9, afterwards I will pull everything with J9 in it from Sheet2 to Sheet1 with it starting at a specific Row, I’ve tried doing AutoFilter but as I am rarely new I believe that my code should be obsolete, please go easy on me. Many Thanks in advance! PS(I am using VBA 2013)
Sub tgr()
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim acrit() As String
Set wsData = Sheets("MaterialReport") 'Copying FROM this worksheet (it contains your data)
Set wsDest = Sheets("TIMINGBELTWPULLEY") 'Copying TO this worksheet (it is your destination)
'Populate your array of values to filter for
ReDim acrit(1 To 2)
acrit(1) = "TIMING"
acrit(2) = "PULLEY"
With wsData.Range("C1", wsData.Cells(wsData.Rows.Count, "C").End(xlUp))
.AutoFilter 1, aFruit, xlFilterValues 'Filter using the array, this avoids having to do a loop
'Copy the filtered data (except the header row) and paste it as values
.Offset(1).EntireRow.Copy
wsDest.Cells(wsDest.Rows.Count, "B29").End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False 'Remove the CutCopy border
.AutoFilter 'Remove the filter
End With
This is my code that I’m working with, I’ve pulled it from a training site and edited it to my needs
I'm having an Excel Spreadsheet with 3 sheets inside and I need to copy certain cell range from Sheet1 and copy it to Sheet2.
And I'm trying to get the range of cells to be copied as an input in a cell that is available in Sheet 3. Like the cell would have value A4:X6 in it. But I'm unable to get the input values passed on to the Range function in my Macro code.
Below is my code and when I execute, it just enters an empty row in the Sheet 2
Sub CopyData()
Sheet3.Select
Set Range1 = Range(Cells(3, 3).Value)
Sheet1.Select
Range1.Copy
Sheet2.Select
Range("A2").Select
Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
I want the contents of cell denoted in Range1 to be copied from Sheet1 and pasted in Sheet2.
Thank you in advance!
John Coleman is right you can avoid using Select for the whole subroutine. But, your problem here is when you define the range it is defining it specifically for Sheet3 and not Sheet1. One alternative is you could store the address in a string that gets passed to the Range() function, but specify which sheet you want your range to reflect. The rest of the code can be handled much the same without using Select.
Sub CopyData()
Dim range1 as Range
dim strRange as String
strRange = Sheet3.Cells(3, 3).Value
Set range1 = Sheet1.Range(strRange)
range1.Copy Sheet2.Range("A2")
Sheet2.Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
Use Set Range1 = Sheet3.Range(Cells(3, 3).Value) instead of Set Range1 = Range(Cells(3, 3).Value) or the range get selected from sheet1 because of Sheet1.Select
when i execute, it just enters an empty row in the Sheet 2 Of course it does. Your code does exactly that. Line Range("A2").EntireRow.Insert Shift:=xlShiftDown creates the row. There is nothing in your code that pastes the content of range A4:X6 ot whatever input you got in the cell.
Actually, if you delete your code and leave it like this:
Sub CopyData()
Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
You will get the same, a new row inserted.
I want the contents of cell denoted in Range1 to be copied from Sheet1 and pasted in Sheet2
I guess you are trying to copy a specific range, not a whole row and paste it, you need something like this:
Sub CopyData()
Dim Range1 As Range
Set Range1 = Sheet1.Range(Sheet3.Cells(3, 3).Value)
Range1.Copy
Sheet2.Range("A2").PasteSpecial (xlPasteAll) 'this command will paste the contents
End Sub
This example shows how to insert a line above line 2, copied to the format of the line down (line 3) and from the header line
Range("2:2").Insert CopyOrigin:=xlFormatFromRightOrBelow
As you understood, .Insert will always insert blank row.
I guess that you would like to paste a range in your sheet and not insert a new row for this you should do like this :
Sheets("SheetName").Range("A2").PasteSpecial (xlPasteAll)
Also note that xlPasteAll is an XlPasteType as xlPasteFormats , xlPasteValues and so on.
xlPasteAll will paste all
xlPasteFormats will paste the source format
xlPasteValues will paste the value
So your code would be as below :
Sub CopyData()
Dim Range1 As Range
Dim Range2 As Range
Set Range1 = Sheet1.Range(Sheet3.Cells(3, 3).Value)'Will define the range you want to copy
Range1.Copy 'here you copy the range
Set Range2 = Sheet2.Range("A2") 'Set the range where you want to paste data
Range2.PasteSpecial (xlPasteValues) 'then you will paste your range
End Sub
Click here to get the list of those XlPasteType
BONUS
Sheet2.Select
Range("A2").Select
is the same as
Set Range2 = Sheet2.Range("A2")
But the last way is better because it avoid Select which can slow down your performances !
Is there a specific requirement for inserting the copied data at the top or would you be happy adding it to the end of the "list" instead? If so, you could find the last used row and add it at the bottom instead like this:
Sub CopyFromSheet1toSheet2()
Dim thisBook As Workbook: Set thisBook = ThisWorkbook
Dim sheetOne As Worksheet: Set sheetOne = thisBook.Worksheets("Sheet1")
Dim sheetTwo As Worksheet: Set sheetTwo = thisBook.Worksheets("Sheet2")
Dim copyFromRange As Range: Set copyFromRange = sheetOne.Range("A4:X6")
Dim lastRow As Long: lastRow = sheetTwo.Cells(Rows.Count, 1).End(xlUp).Row
Dim pasteToRange As Range: Set pasteToRange = sheetTwo.Range("A" & lastRow)
copyFromRange.Copy Destination:=pasteToRange
End Sub
"lastRow" returns the numeric value of the last used row in a given column. If you have data in A1:A4 then this code would add the next lot of data copied to A5 and below.
I have code to copy a Worksheet A, columns A:C (no set row quantities, this will be re-used and the quantities will change) and paste to the first blank row in the same workbook, different sheet, Worksheet B (this also has no set row quantities and will change).
Worksheet B has a formula in the same columns that I want to paste to that returns "" if there is no data. I think VBA is seeing the "" and assuming there is data there; however, it is not pasting even to lines without said formula.
Sub Copy_Created_Fringe_Accounts()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestSheet As Worksheet
Dim LastRow As Long
'Source sheet and range
Set SourceRange = Sheets("CREATED FRINGE ACCTS").Range("A2:C500")
'Destination sheet and range
Set DestSheet = Sheets("99 BUDGET WORKSHEET")
'Last Row
LastRow = DestSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Copy and paste to destination
Set DestRange = DestSheet.Range("A" & LastRow + 1)
SourceRange.Copy DestRange
End Sub
Nothing happens when I run it. I expect to see the data from Worksheet A copied to Worksheet B, starting at the first available empty row.
I am fairly new to VBA so any help/understanding is appreciated.
Finding the last row
Try using UsedRange to find the last used row as this is safer than using Find.
LastRow = DestSheet.UsedRange.Rows.Count
A side note
If your code resides in the same place as these worksheets then I would recommend using their code name. This will protect you from running into an error if the sheet doesn't exist.
I have a spreadsheet I'm using to compile text that changes all the time.
In column AD, Row 4(AD4) I put the contents of text, and it can have data going 1000 to 4000 rows down. It changes every time, so there is no static range name. I need a macro that
finds the final piece of data in that column,
then automatically "drags a box" from that spot two columns to the left (AB4)
and copies it... (A 3000 row piece of text would be AB4:AD3004) (Macro stops there, with text to be copied highlighted)
The current version finds the bottom cell correctly, but if I run the macro a 2nd time, with new data, it keeps trying to copy the same range. (I used the Formula Define.Name method, to name the cell, and then selected AB4:LastRow) but it is ALWAYS 3160 whether data goes to row 4000 or not.....
Sub Last_row()
Cells(Application.Rows.Count, 30).End(xlUp).Select
' following lines of code are useless
Range("AB4:AD3160").Select
Range("AD3160").Activate
Selection.Copy
End Sub
To answer your question directly:
With Sheet1
.Range("AB4", .Cells(Rows.Count, "AD").End(xlUp)).Copy
End With
Copy to specific location WITHOUT using clipboard:
With Sheet1
.Range("AB4", .Cells(Rows.Count, "AD").End(xlUp)).Copy Sheet2.[A1]
End With
Copy and exclude formatting:
With Sheet1
With .Range("AB4", .Cells(Rows.Count, "AD").End(xlUp))
Sheet2.Cells(1, "A").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End With
Note: Replace all sheet codenames (sheet1, Sheet2) above with your actual sheet codenames.
Your current code hard-codes the range of interest with
Range("AB4:AD3160").Select
This code will define a dynamic range starting from AB4 to the last non-empty cell in column AD
You can then use this range (without selecting) for changing values elsewhere (note that you may not need to actually copy rng1, it is possible to dump these values to a separate range directly without a copy and paste.
Sub Last_row()
Dim rng1 As Range
Set rng1 = Range([ab4], Cells(Rows.Count, 30).End(xlUp))
rng1.Copy
End Sub
Update: Example of how to copy a dynamic sized range from one sheet to another without a copy and paste:
Sub Last_row2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
Set rng1 = ws1.Range(ws1.[ab4], ws1.Cells(Rows.Count, 30).End(xlUp))
ws2.[a1].Resize(rng1.Rows.Count, rng1.Columns.Count).Value = rng1.Value
End Sub