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
Related
I need to be able to copy different ranges of cells from one worksheet to another. For example A1:A4, C3:C7, D3:D6. I need the code to do the following:
Copy different data from those cells in the first worksheet (worksheet1) and paste them onto the same line but transposed on the second worksheet (worksheet2). I don't need to keep the original formatting.
When pasting the data I need it to find the last row and paste it below that row.
I can write a code which will do most of that but I only know how to get the code to do it for one cell range e.g. A1:A4.
Any help would be greatly appreciated.
OK, technically SO isn't a code-writing service but I use a code that does basically just that, so you might as well have it;
Sub CopyTransposeRange()
Dim shtCopy As Worksheet
Dim shtPaste As Worksheet
Dim rngCopy As Range
Set shtCopy = Sheets("Sheet1").Activate
Set shtPaste = Sheets("Sheet2")
Set rngCopy = Range("A1:A36")
'Put whatever's necessary in here to select the correct range
shtCopy.rngCopy.Copy
shtPaste.Activate
shtPaste.Range(Cells(shtPaste.UsedRange.Rows.Count + 1, 1), Cells(shtPaste.UsedRange.Rows.Count + 1, rngCopy.Rows.Count)).PasteSpecial _
xlPasteAll, xlPasteSpecialOperationNone, False, True
End Sub
Yes, I know activating sheets isn't best practice, but works for me ¯_(ツ)_/¯
hope it helps.
Try this code, please.
It will copy your selected range and transpose it in the roe 2 of second sheet:
Sub testCopyTransposedRanges()
Dim sh2 As Worksheet, inpRng As Range, lastCol As Long, arrTr As Variant
Set inpRng = Application.InputBox("Select range to be copied and transposed:", _
"Range Selection", Selection.Address, Type:=8)
If inpRng Is Nothing Then Exit Sub
arrTr = inpRng.value
If IsEmpty(arrTr) Then Exit Sub
Set sh2 = Worksheets("worksheet2") ' use here your sheet name!!!
lastCol = sh2.Cells(2, Cells.Columns.Count).End(xlToLeft).Column + 1
sh2.Cells(2, lastCol).Resize(, UBound(arrTr)).value = WorksheetFunction.Transpose(arrTr)
End Sub
It must be 'filterred' for 'Cancel', multi column selection etc. But this will be done only if such a solution matches your need. Otherwise, you must present the logic based on what to create an algorithm to automatically select the necessary ranges.
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 hope i can explain this well. I am having a difficulty in my code and what code should i use.
I have a big data, that needs to be filter first. and the range is not consistent.
after filtering data, i have to copy the second row (this is not to copy the Column name), until the last row with blanks.
I tried this code, but it didn't work
Sheets("Big5").Select
Range("P1").Select
Dim testlrow As Long
testlrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Dim rngBIGcode As Range
Set rngBIGcodeM = Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))
rngBIGcodeM.SpecialCells(xlCellTypeVisible).Cells(1).Select
Range(Selection, Selection.End(xlDown) & testlrow).Select
I have to copy the second row from P1, until the last row.
There are a few problems with your code, starting with using Select and ActiveCell. You also declare your range, then use a different name to Set. One way to ensure your variables are properly declared is to type Option Explicit above your Sub. Then it will verify your variables. Ensure that your objects are well-defined by using the worksheet variable in front of the cells. This is how your code could work:
Sub Test ()
Dim ws As Worksheet
Dim testlrow As Long
Dim rngBIGcodeM as Range
Set ws = Sheets("Big5")
testlrow = ws.Cells(Rows.Count, "P").End(xlUp).Row
Set rngBIGcodeM = ws.Range(ws.Cells(2, "P"), ws.Cells(testlrow, "P"))
rngBIGcodeM.SpecialCells(xlCellTypeVisible).Copy 'Enter Destination Here
Application.CutCopyMode = False
End Sub
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
Iam a DB Guy and i dont know anything about VB.
I have a Macro in Excel and in Excel i have cross tabular records.
My macro will convert Crosstabular records to tabular records.
But My requirement is i want to Run the Same Macro outside the excel.
.VBS file should be there and whenever we run the .VBS it should pick excel from some place and convert the crosstab records to tabular records and save at some different location.
I have created a Code for the same by googling and Somebody Please review my below code and help me with the Proper code.
Sub RunMacro()
Dim xlApp 'As Excel.Application
Dim xlBook 'As Workbook
Dim xlSheet 'As Worksheet
Dim wsCrossTab 'As Worksheet
Dim wsList 'As Worksheet
Dim iLastCol 'As Long
Dim iLastRow 'As Long
Dim iLastRowList 'As Long
Dim rngCTab 'As Range 'Used for range in Sheet1 cross tab sheet
Dim rngList 'As Range 'Destination range for the list
Dim I 'As Long
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("D:\Source.xls")
CrossTabToList()
xlBook.SaveAs "D:\Results.xls"
xlApp.Quit
End Sub
Sub CrossTabToList()
Set wsCrossTab = Worksheets("Tabular")
Set wsList = Worksheets.Add
'Find the last row in Sheet1 with the cross tab
iLastRow = wsCrossTab.Cells(Rows.Count, "A").End(xlUp).Row
'Set the initial value for the row in the destination worksheet
iLastRowList = 2
'Find the last column in Sheet1 with the cross tab
iLastCol = wsCrossTab.Range("A8").End(xlToRight).Column
'Create a new sheet and set the heading titles
wsList.Range("A1:C1") = Array("CATEGORY", "SUBCATEGORY", "VALUE")
'Start looping through the cross tab data
For I = 2 To iLastRow
Set rngCTab = wsCrossTab.Range("A" & I) 'initial value A2
Set rngList = wsList.Range("A" & iLastRowList) 'initial value A2
'Copy individual names in Col A (A2 initially) into as many rows as there are data columns in the cross tab (less 1 for Col A).
rngCTab.Copy rngList.Resize(iLastCol - 1)
'Move up a I rows less one and across one column (using offset function) to select heading row. Copy.
rngCTab.Offset(-(I - 1), 1).Resize(, iLastCol - 1).Copy
'Paste transpose to columns in the list sheet alongside the names
rngList.Offset(0,1).PasteSpecial Transpose:=True
'Staying on same row (2 initially) copy the data from the cross tab
rngCTab.Offset(, 1).Resize(, iLastCol - 1).Copy
'Past transpose as column in list sheet
rngList.Offset(0, 2).PasteSpecial Transpose:=True
'Set the new last row in list sheet to be just below the last name copied
iLastRowList = iLastRowList + (iLastCol - 1)
'increment I by 1
Next I
Application.DisplayAlerts = False
Sheets("Tabular").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Results"
objwkbk.SaveAs "D:\Results.xls"
End Sub
Thanks,
Praveen
As i mentioned i am not a Java Developer or Coding guy,i am a Database person ,i dont know anything about Java .I want to use the above code as .VBS file.I want somebody to correct my above code to use it in a .VBS File.If you can do that it will be really appreciated.
Thanks in Advance.
That's a very good idea. VBA in an Excel file can confuse users, so I try to avoid that whenever possible.
I recommend storing your procedure in an Access file. There's a little work involved in converting it, but this should get you started:
Make a new Access db
In your new db, make a new VBA module. Paste your code in there.
Add your most current version of Microsoft Excel Object Library.
Make whatever other changes are necessary to get the code in working order again (you'll have to do a bit of trial and error. Run the code repeatedly and deal with the error messages as they pop up)
Change your Sub to a Function (you need to do this to call it from a Macro)
Make a new Macro. Add the action RunCode with the argument RunMacro()
In the future, all you will have to do is open the db and click on the macro to run the code.