I'm working on a macro to copy certain rows (if column A isn't blank) of worksheet 'A' to worksheet 'B'. After a little bit of research the following code suddenly appeared. Only thing that I don't seem to work out is to copy the cell values instead of the linked formula, I tried to implement the 'copy/paste special' command, but I don't get the specific coherent code language.
Sub Samenvattend()
'
' Samenvattend Macro
'
' Sneltoets: Ctrl+Shift+S
'
Dim a As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("gedetailleerde meetstaat")
Set Target = ActiveWorkbook.Worksheets("samenvattende meetstaat")
j = 1 ' Start copying to row 1 in target sheet
For Each a In Source.Range("A1:A10000") ' Do 10000 rows
If a <> "" Then
Source.Rows(a.Row).Copy Target.Rows(j)
j = j + 1
End If
Next a
End Sub
Thanks :)
If you're just trying to set the values of two cells equal, you can skip copy/paste, and simply set the ranges' values equal to one another.
This also lets you skip using the Clipboard and tends to be a little faster.
Just remember when doing this, it's [DESTINATION range].value = [ORIGIN range].value whereas with copy/paste, it's [ORIGIN range].copy [DESTINATION range].
For Each a In Source.Range("A1:A10000") ' Do 10000 rows
If a <> "" Then
Target.Rows(j).value = Source.Rows(a.Row).Value
j = j + 1
End If
Next a
Related
I am trying to copy and paste a range in values without using the clipboard, below code works but doesn't copy in values (includes forumlas etc):
any ideas as how to make this work?
NbRowsPnLD1 = PnLD1WS.Range("A1").End(xlDown).Row
PnLD1WS.Range(PnLD1WS.Cells(1, 1), PnLD1WS.Cells(NbRowsPnLD1, 228)).Copy(PnLD2WS.Cells(1, 1)).PasteSpecial xlPasteValues
Copy the Values of a Range by Assignment
Option Explicit
Sub CopyByAssignment()
' It is assumed that 'PnLD1WS' and 'PnLD2WS' are the code names
' of two worksheets in the workbook containing this code.
' Calculate the last row,
' the row with the last non-empty cell in the column.
' Most of the time you want to use '.End(xlUp)' instead:
Dim slRow As Long
slRow = PnLD1WS.Cells(PnLD1WS.Rows.Count, "A").End(xlUp).Row
' ... because if you have empty cells in the column, it will reference
' the whole range regardlessly.
' The following will 'stop' at the first empty cell and may not reference
' the whole desired column range.
'slRow = PnLD1WS.Range("A1").End(xlDown).Row ' not recommended
' Reference the source range (the range to be copied from).
Dim srg As Range
Set srg = PnLD1WS.Range("A1", PnLD1WS.Cells(slRow, "HT"))
' Reference the destination range (the range to be written (pasted) to).
' Use 'Resize' to make it the same size as the source range.
Dim drg As Range
Set drg = PnLD2WS.Range("A1").Resize(srg.Rows.Count, srg.Columns.Count)
' Copy by assignment.
drg.Value = srg.Value
End Sub
Something like
With PnLD1WS.Range(PnLD1WS.Cells(1, 1), PnLD1WS.Cells(NbRowsPnLD1, 228))
PnLD2WS.Cells(1, 1).Resize(.Rows.Count,.Columns.Count).Value2 = .Value2
End With
Hey i have a small problem that i can´t seam to solve... Im not the first to have this problem i found but none of the existing solutions worked on my code. so im stuck... The problem is that my code runs faster then what the functions can execute.
My code adds all worksheets that are of the same type together in a new sheet. And to indicate when how long every file is in the new sheet i want to change the interior of the last row to another color. My code can do that now but only in debug mode... and i don´t know how to "slow it down" so that i works whit my macro. Iv tried a delay function, DoEvent and adding a timer but none worked... Would really appreciate some tips on how to solve this or if there is a better way to do this. Thanks!
Sub MergeSheets()
Dim WorkSheetSource As Worksheet
Dim WorkSheetDestination As Worksheet
Dim RangeSource As Range
Dim RangeDestination As Range
Dim lngLastCol As Long
Dim lngSourceLastRow As Long
Dim lngDestinationLastRow As Long
Dim SheetName As String
Dim SkipSheets As String
'Set references up-front
Set WorkSheetDestination = ThisWorkbook.Worksheets("Import")
lngDestinationLastRow = LastOccupiedRowNum(WorkSheetDestination) '<~ defined below (and in Toolbelt)!
lngLastCol = LastOccupiedColNum(WorkSheetDestination) '<~ defined below (and in Toolbelt)!
'Set the initial destination range
Set RangeDestination = WorkSheetDestination.Cells(lngDestinationLastRow + 1, 1)
' (lngDestinationLastRow + 2) = what row to start adding on, 1 = start from column
' Skip this sheets ' the 2 makes a blank row between sheeeeets
SkipSheets = ("Import, Cover sheet, Control, Column description, Charts description")
'Loop through all sheets
For Each WorkSheetSource In ThisWorkbook.Worksheets ' Here i coud add a function where i can choose my Sheets?
DoEvents
'Make sure we skip the "Import" destination sheet!
If InStr(1, SkipSheets & ",", WorkSheetSource.Name & ",", vbTextCompare) = 0 Then
' Skip all Charts sheets
If InStr(WorkSheetSource.Name, "Status") Then
'Identify the last occupied row on this sheet
lngSourceLastRow = LastOccupiedRowNum(WorkSheetSource)
'Store the source data then copy it to the destination range
With WorkSheetSource
Set RangeSource = .Range(.Cells(3, 1), .Cells(lngSourceLastRow, lngLastCol)) ' 3 = what start row , 2 = how many columns
RangeSource.Copy Destination:=RangeDestination
End With
'Redefine the destination range now that new data has been added
LongDestinationLastRow = LastOccupiedRowNum(WorkSheetDestination)
Set RangeDestination = WorkSheetDestination.Cells(LongDestinationLastRow + 1, 1)
'LongDestinationLastRow.EntireRow.Interior.ColorIndex = 15
End If
' Find last row and give it colour
'Range("A" & Rows.Count).End(xlUp).Select
'ActiveCell.EntireRow.Interior.ColorIndex = 15
' don´t work... only in debugmode
End If
' **** Here the code works in debug mode but not in macro!*****
' Find last row and give it colour
Range("A" & Rows.Count).End(xlUp).Select
ActiveCell.EntireRow.Interior.ColorIndex = 15
'*************************************************************
Next WorkSheetSource
MsgBox "Done"
End Sub
I have a code that reads in the new arrangement of columns from a text file and then rearrange the original columns by copying it in at the correct place, however there is a bug in my code. Instead of copying just 1 column it seems to copy all columns to the right of the column that i want to copy..
so i guess the error is here
'copy the old range
ws.Range(ws.Cells(Settings.rowHeader + 1, CounterCol), ws.Cells(lrow, CounterCol)).Copy
I want to copy the range AW3:AW80 to A3:A80, but do i need to copy AW:AW to A:A instead? If i do so the stuff in row 1 will be deleted, below is the full code:
Sub insertColumns()
Call Settings.init
Dim i As Integer
Dim ws As Worksheet
Dim lrow As Integer
Dim columNames As Object
Dim temp As Variant
'fill dictionary with columnnames from text file
Set columNames = FileHandling.getTypes(Settings.columnFile)
Set ws = ActiveWorkbook.Sheets("List")
'Get max column and row number
lColumn = HelpFunctions.getLastColumn(ws, Settings.rowHeader)
lrow = HelpFunctions.getLastRow(ws, HelpFunctions.getColumn("*part*", ws, Settings.rowHeader))
'Insert all new columns in reverse order from dictionary
temp = columNames.keys
For i = columNames.Count - 1 To 0 Step -1
ws.Columns("A:A").Insert Shift:=xlToRight
ws.Range("A" & Settings.rowHeader).Value = temp(i)
Next i
'last column
lastColumn = lColumn + columNames.Count
'we loop through old cells
CounterCol = columNames.Count + 1
Do While CounterCol <= lastColumn
j = 0
'through each elemnt in dictionary
For Each element In temp
j = j + 1
'compare the old rowheader with any of the rowheader in DICTIONARY
If UCase(ws.Cells(Settings.rowHeader, CounterCol).Value) = element Then
'copy the old range
ws.Range(ws.Cells(Settings.rowHeader + 1, CounterCol), ws.Cells(lrow, CounterCol)).Copy
'paste it
ws.Cells(Settings.rowHeader + 1, j).Select
ws.Paste
'format the new row
ws.Cells(Settings.rowHeader + 1, j).EntireColumn.AutoFit
'Delete the old row
ws.Columns(CounterCol).EntireColumn.Delete
'decrease the last column by one since we just deleted the last column
lastColumn = lastColumn - 1
found = True
'Exit For
End If
Next element
'Prompt the user that the old column does not match any of the new column
If Not found Then
MsgBox (UCase(ws.Cells(Settings.rowHeader, CounterCol)) & " was not a valid column name please move manually")
End If
'reset the found
found = False
'go to nect column
CounterCol = CounterCol + 1
Loop
End Sub
Below is a screenshot of the dictionary.
After the first iteration/first copy it should have only copied over the part number column, but as can been seen it has copied over more than just the first column(everything except of drawing number)
Q: I want to copy the range AW3:AW80 to A3:A80, but do i need to copy AW:AW to A:A instead?
A: No. Any range can be copied.
Rather than trying to debug your code, I'll give you a hint about how to debug such a thing. Lines like
ws.Range(ws.Cells(Settings.rowHeader + 1, CounterCol), ws.Cells(lrow, CounterCol)).Copy
are hard to debug because they are trying to do too much. You have 4 instances of the dot operator and suspected that the problem was with the last one (.Copy). The problem is almost certainly that your code isn't grabbing the range that you think it is grabbing. In other words, one or more of your method invocations earlier in the line needs debugging. In such a situation it is useful to introduce some range variables, set them equal to various values and print their addresses to the immediate window to see what is happening. As an added benefit, having set range variables allows you to use the full power of intellisence in the VBA editor. Something like:
Dim SourceRange As Range, Cell1 As Range, Cell2 As Range
'
'
'
Set Cell1 = ws.Cells(Settings.rowHeader + 1, CounterCol)
Set Cell2 = ws.Cells(lrow, CounterCol)
Set SourceRange = ws.Range(Cell1, Cell2)
Debug.Print Cell1.Address & ", " & Cell2.Address & ", " & SourceRange.Address
'
'Once the above is debugged:
'
SourceRange.Copy 'should work as expected
It is possible that you are copying the range that you want to copy but that your larger program still isn't working. In that case you have some sort of logic error and should be trying to copy some other range. Even then, the above exercise still helps because it makes it clear exactly what your original line was doing.
'go to nect column
CounterCol = CounterCol + 1
needed to be deleted. It has to do that the column shifts left when i deleted rows.
Thanks for the help. I hope the code can be used for others who might need to add columns, but still copy over content from old columnsin the right order.
I am trying to copy data from range C2:G2 in sheet1 tab onto sheet2 tab range C4:C8. Below is my code but it just pastes the value in cell c2 of sheet 1 repeatedly onto sheet 2 range C4:C8. Can you please help?
Also , I need to copy the value of cell c12 in sheet 1 onto e4 of sheet 2, f12 in sheet 1 onto e5 of sheet 2, i12 in sheet 1 onto e6 of sheet 2, L12 in sheet 1 onto e7 of sheet 2, O12 in sheet 1 onto e8 of sheet 2
Thanks in advance
Andy
Sub ticker1() 'COPY DATA FROM ROW ONE SHEET INTO A COLUMN on another sheet
Sheets("Sheet2").Range("C4:C8").Value = Sheets("Sheet1").Range("C2:G2").Value
End Sub
Your code was very close. In fact, it may have worked. I'm not sure. Using select & activate is inevitably an issue. Avoid it..
This isn't really an answer. Just some food for thought as you're learning to program. My comments start with {--
Option Explicit ' {--option explicit forces you to declare your variables. Do this. Always.
Sub ticker()
'{group your variable declarations together}
Dim numberOfCellsToCopy As Integer
Dim currentCopyColumn As Integer
Dim currentPasteRow As Integer
Dim i As Integer
' {--use a worksheet object instead of selecting}
Dim srcWs As Worksheet
Dim destWs As Worksheet
'assign where to insert the columns
currentCopyColumn = 2
currentPasteColumn = 2
numberOfCellsToCopy = 5
' {--Set worksheet objects}
Set srcWs = ThisWorkbook.Worksheets("HistoricalDataRequest")
Set destWs = ThisWorkbook.Worksheets("SomeOtherWorksheet")
For i = 2 To numberOfCellsToCopy 'loop increases by 1??? {--YES. It does.}
' {--indent your code so it's easier to see program flow
' {--I have no idea what you're trying to do here.... sorry. You're only copying one cell
' --so I really can't figure what you're trying to accomplish}
'Range(Cells(2, currentCopyColumn), Cells(2, currentCopyColumn)).Select 'number =row
'Selection.Copy 'number =row
'Range(Cells(7, currentPasteColumn), Cells(7, currentPasteColumn)).Select
'ActiveSheet.Paste
' {--copy/paste can be done in one line using a range object
' --range uses a cell name.}
srcWs.Range("B2").Copy Destination:=destWs.Range("B7")
' { --or more in line with your method like this}
srcWs.Range(srcWs.Cells(2, currentCopyColumn)).Copy Destination:=destWs.Range(destWs.Cells(7, currentPasteColumn))
'increase the column index values to go to the next one
currentCopyColumn = currentCopyColumn + 1
currentPasteColumn = currentPasteColumn + 4
Next i ' {--next i will increment the i var for you}
End Sub
based on your edited code, this should work:
Sheets("Sheet5").Range("C4:C8").Value = Application.WorksheetFunction.Transpose(Sheets("Sheet2").Range("C2:G2").Value)
As your arrays are in different orientations, the transpose function will align them correctly.
There are a few other ways of doing this, but this is probably the most direct (if you do not need too much flexibility with your ranges).
I begin the process of streamlining the work, so...
I need a VBA code that copy only the cells with value, within a range specified, to ONE column. I want that the effect will be immediate. Once I insert data the column will be update.
example:
copy only the cells with numbers, within a range A2:D9, to column F.
in the real VBA code I don't want it to be limited to a small range, because I have more column then A-D, and they long then 9 rows. So if I could define it a range (but in the code and not in new pop-up windows), this would be an excellent :)
the COLORS and column G are meaningless. This is just for example.
Screenshot:
Thank you for your patience and time...
Appreciate it very much !
Do it like this:
Sub Macro1()
'
' Macro1 Macro
'
Dim SourceRange As Range
Dim TargetRange As Range
Dim addedCells As Integer
'
Application.Calculation = xlManual
Set TargetRange = Range("F2:F34")
addedCells = 0
Set SourceRange = Range("A2:D9")
For Column = 1 To SourceRange.Columns.Count
For Row = 1 To SourceRange.Rows.Count
If Not (SourceRange.Cells(Row, Column) = "") Then
addedCells = addedCells + 1
TargetRange.Cells(addedCells, 1) = SourceRange.Cells(Row, Column)
End If
Next Row
Next Column
Calculate
Application.Calculation = xlAutomatic
End Sub
Add some parameters to make it dynamic.