I have a problem with VBA code not pasting values
The code goes as following
Set rngSrc = .Range("D29")
rngSrc.Copy Destination:=rngDst
The problem is that I get only #REF errors since the VBA tries to paste whatever the cell has but I would like it to paste special values and I cant make it work with paste special function.
Does someone know how to make it work?
You're almost there, but instead of the Destination method, you should be using PasteSpecial instead, check this nifty code below:
Private Sub copypaste()
Dim rngSrc As Range
Dim rngDest As Range
Dim ws As Worksheet: Set ws = Sheets("Your sheet name")
Set rngSrc = ws.Range("D29")
Set rngDest = ws.Range("A33") ' for example
rngSrc.Copy
rngDest.PasteSpecial xlPasteValues
End Sub
I feel like the code is pretty self-explanatory. Though if you have any questions, let me know
Your CombineDataFromAllSheets code should be:
Public Sub CombineDataFromAllSheets()
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
Set wksDst = ThisWorkbook.Worksheets("Import")
For Each wksSrc In ThisWorkbook.Worksheets
'These need updating on each pass of the loop.
'Set them at the start, rather than before the loop
'and at the end of the loop.
lngDstLastRow = LastOccupiedRowNum(wksDst)
lngLastCol = LastOccupiedColNum(wksDst)
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
If wksSrc.Name <> "Import" Then
lngSrcLastRow = LastOccupiedRowNum(wksSrc)
With wksSrc
Set rngSrc = .Range("D29")
rngSrc.Copy
rngDst.PasteSpecial xlPasteValues
End With
End If
Next wksSrc
End Sub
Related
I currently have a macro that merges all the tabs except for a tab named "Combined". This combined sheet will be the destination of the merging of all tabs/sheets. However, I want to exclude some of the tabs from being combined.
For example, I have 5 tabs: Combined, tab1, tabA, tab2, tabB. All tabs have similar number of columns/column headers. When I run the macro it will merge tab1, tabA, tab2, and tabB into Combined. What I want to revise with my current macro is to only combine tab1 and tabA. How will I need to change my current macro?
Here is my current macro:
Option Explicit
Public Sub CombineDataFromAllSheets()
Sheets("Combined").Rows("2:" & Sheets("Combined").Rows.Count).ClearContents
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("Combined")
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!
'Set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
'Loop through all sheets
For Each wksSrc In ThisWorkbook.Worksheets
'Make sure we skip the "Import" destination sheet!
If wksSrc.Name <> "Combined" Then
'Identify the last occupied row on this sheet
lngSrcLastRow = LastOccupiedRowNum(wksSrc)
'Store the source data then copy it to the destination range
With wksSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
rngSrc.Copy Destination:=rngDst
End With
'Redefine the destination range now that new data has been added
lngDstLastRow = LastOccupiedRowNum(wksDst)
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
End If
Next wksSrc
End Sub
Define an array with the sheet names and then iterate this array
Dim arrSheets(1) as String
arrSheets(0) = "tab1"
arrSheets(1) = "tabA"
Dim i as long
For i = 0 to Ubound(arrSheets)
Set wksSrc = Thisworkbook.worksheets(arrSheets(i))
....
next
BTW 1: Avoid implicit referencing of sheets and ranges - always use explicit referencing, like thisworkbook.worksheets or wksSrc.range(...)
BTW 2: You don't need copy/paste - just write the values to the target:
With rngSrc
rngDst.Resize(.Rows.Count, .Columns.Count).Value = .Value 'this is much faster and you don't need the clipboard
End With
#Ike offered a great answer. Theirs and mine are two variations on the same idea: Create a list of sheets to work on, and then loop through that instead of through all sheets in the workbook.
I also cleaned up some other parts to better implement this new idea. Here is the revised code:
Option Explicit
Public Sub CombineDataFromAllSheets()
Dim wksSrc As Variant, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
Dim SourceSheets As Variant
'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("Combined")
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!
'List of sheets to operate on
SourceSheets = Array( _
ThisWorkbook.Worksheets("tab1"), _
ThisWorkbook.Worksheets("tabA") _
)
wksDst.Rows("2:" & Sheets("Combined").Rows.Count).ClearContents
'Set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
'Loop through all sheets
For Each wksSrc In SourceSheets
'Identify the last occupied row on this sheet
lngSrcLastRow = LastOccupiedRowNum(wksSrc)
'Store the source data then copy it to the destination range
With wksSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
rngSrc.Copy Destination:=rngDst
End With
'Redefine the destination range now that new data has been added
lngDstLastRow = LastOccupiedRowNum(wksDst)
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
Next wksSrc
End Sub
I am trying to copy data from cells F11:Z22 on multiple sheets and output the data onto one summary sheet.
Sample of Data to Copy
There is the possibility to have new sheets added. I would like to get data from those sheets as well.
I have Sheets "SummarySheet", "Import", "TemplateSheet" I do not want to copy data from. The other sheets I do.
The ideal output would be just all of the values listed out in the "Import" sheet.
Example of Result
I tried a few different macros. This one logically works the best. When I execute it, nothing happens.
Sub SummarizeSKUdata()
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
'Notes: "Src" is short for Source, "Dst" is short for Destination
'Set Referances up-front
Set wksDst = ThisWorkbook.Worksheets("Import")
lngDstLastRow = wksDst.Cells.SpecialCells(xlCellTypeLastCell).Row '<-defined below
lngLastCol = wksDst.UsedRange.Columns(wksDst.UsedRange.Columns.Count).Column '<-defined below
'set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
'Loop Through all sheets
For Each wksSrc In ThisWorkbook.Worksheets
'Make Sure we skip the Summary Sheet
If wksSrc.Name <> "SummarySheet" Then
If wksSrc.Name <> "Import" Then
If wksSrc.Name <> "TemplateSheet" Then
'Identify the last row occupied on this sheet
lngSrcLastRow = wksDst.Cells.SpecialCells(xlCellTypeLastCell).Row
'Store the source data then copy it to the destination range
With wksSrc
Set rngSrc = Range("F11:Z22")
rngSrc.Copy Destination:=rngDst
End With
'Redefine the destination range now that new data has been added
lngDstLastRow = wksDst.Cells.SpecialCells(xlCellTypeLastCell).Row
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
End If
End If
End If
Next wksSrc
End Sub
I was able to figure it out with this code below.
Sub SummarizeSKUdata()
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
'Notes: "Src" is short for Source, "Dst" is short for Destination
'Set Referances up-front
Set wksDst = ThisWorkbook.Worksheets("Import")
wksDst.Rows("2:" & Rows.Count).ClearContents
'set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 2, 1)
'Loop Through all sheets
For Each wksSrc In ThisWorkbook.Worksheets
lngDstLastRow = wksDst.Cells.SpecialCells(xlCellTypeLastCell).Row '<-defined below
lngLastCol = wksDst.UsedRange.Columns(wksSrc.UsedRange.Columns.Count).Column '<-defined below
'Make Sure we skip the Summary Sheet
If wksSrc.Name <> "SummarySheet" Then
If wksSrc.Name <> "Import" Then
If wksSrc.Name <> "TemplateSheet" Then
'Identify the last row occupied on this sheet
lngSrcLastRow = wksDst.Cells.SpecialCells(xlCellTypeLastCell).Row
'Store the source data then copy it to the destination range
With wksSrc
wksSrc.Range("F11:Z22").Copy
rngDst.PasteSpecial Paste:=xlPasteValues
End With
'Redefine the destination range now that new data has been added
lngDstLastRow = wksDst.Cells.SpecialCells(xlCellTypeLastCell).Row
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
End If
End If
End If
Next wksSrc
End Sub
Update: I realized that I can't use union on multiple sheets.
What's the best choice that I have then?
I simply want to combine all sheets in the workbook into the first worksheet.
After I went through the existing questions, I've tried adding Set rng = nothing to clear my range, but it didn't help.
Sub Combine()
Dim J As Long
Dim Combine As Range
Dim rng As Range
'I want to start from the second sheet and go through all of them
For J = 2 To Sheets.Count
With Sheets(J)
Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
End With
For Each Cell In rng
If Combine Is Nothing Then
Set Combine = Cell.EntireRow
Else
Set Combine = Union(Combine, Cell.EntireRow)
End If
Next Cell
Set rng = Nothing
Next J
'Paste the whole union into the 1st sheet
Combine.Copy Destination:=Sheets(1).Range("A1")
End Sub
All this code gets me an error Method 'Union' of object '_Global failed
Update 2
Sub Combine2()
Dim rowcount As Long
For Each Sheet In Sheets
If Sheet.Index <> 1 Then
rowcount = Sheet.UsedRange.Rows.Count
Sheet.UsedRange.Copy Destination:=Sheets(1).Cells(Lastrow + 1, 1)
Lastrow = Lastrow + rowcount
End If
Next Sheet
End Sub
Really simple code, worked perfectly, thanks to #luuklag for leading me on this.
Indeed .Union method doesn't work across worksheets.
Instead, you could try looping through all your worksheets, copying the corresponding range and pasting it to the destination worksheet.
Something like the following would achieve this:
Sub test()
Dim destinationSheet As Worksheet
Dim sht As Worksheet
Dim destinationRng As Range
Dim rng As Range
Set destinationSheet = ThisWorkbook.Worksheets("Name of your worksheet")
For Each sht In ThisWorkbook.Worksheets
If sht.Name <> destinationSheet.Name Then
With sht
Set rng = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
rng.Copy
End With
With destinationSheet
Set destinationRng = .Range("A" & .Rows.Count).End(xlUp)
If destinationRng.Address = .Range("A1").Address Then
destinationRng.PasteSpecial xlPasteValues
Else
destinationRng.Offset(1, 0).PasteSpecial xlPasteValues
End If
End With
End If
Next sht
End Sub
The code above pastes the ranges one by one, in the same column. It can be easily modified to paste the ranges in different columns, one next to the other.
I have some code in which I am trying to sort the data set in a csv file based on the content of a cell in another (the main) workbook. Then based on this sort, copy a range of visible cells between the first and sixth columns, but with a dynamic last row thus the range will be dynamic. This dynamic range is then pasted into the main sheet, which will then allow me to do further work on this dataset.
Can't seem to get the sort to work or the dynamic range working. I've tried all sorts of variation on the code below and am looking for some inspiration.
Sub Get_OA_Data()
'Find OA data from source SQL file and copy into serial number generator
Dim ws As Worksheet
Dim wkb2 As Workbook
Dim ws2 As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
'This section sets the workbooks and worksheets to be used for this macro
Set ws = ThisWorkbook.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srvabdotfpr08\PC_APPS\forum\Gateshead Serialisation\sys_serialisation1.csv")
Set ws2 = wkb2.Worksheets("sys_serialisation1")
Set rng2 = ws.Range("F6")
' This line deletes any content of the cannot assign serial number added previously
ws.Range("I6:I7").ClearContents
'This hides all rows which do not match the desired OA number (found in rng2)
For Each Cell In ws2.Range("A1").End(xlDown)
If Left(Cell.Value, 6) <> rng2.Value Then
Cell.EntireRow.Hidden = True
End If
Next Cell
Set StartCell = ws2.Range("A1")
LastRow = StartCell.SpecialCells(xlCellTypeVisible).Row
LastColumn = StartCell.SpecialCells(xlCellTypeVisible).Column
'This section selects and copies the visible range from csv file into serialisation generator
Set rng = ws2.Range(StartCell.ws2.Cells(LastRow, LastColumn))
rng.Copy
ws.Activate
ws.Range("D12").Select
Selection.PasteSpecial 'Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Any help would be greatly appreciated, I've bought a couple of books, but none of the stuff in my books is helping with this issue.
P.S I have used very similar code with specific set ranges and it works fine, but this one has me stumped. There may also be an issue with the dataset- which is why I have the LEFT formula in the code (but this seems to work OK).
Try...
Option Explicit
Sub Get_OA_Data()
Dim wkb2 As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim rng As Range, xCell As Range
Dim LR As Long, LC As Long, LR2 As Long
Set ws = ThisWorkbook.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srvabdotfpr08\PC_APPS\forum\Gateshead Serialisation\sys_serialisation1.csv")
Set ws2 = wkb2.Worksheets("sys_serialisation1")
ws.Range("I6:I7").ClearContents
LR2 = ws2.Range("A" & ws.Rows.Count).End(xlUp).Row
For Each xCell In ws2.Range("A1:A" & LR2)
xCell.EntireRow.Hidden = Left(xCell.Value, 6) <> ws.Range("F6")
Next xCell
LR = ws2.Range("A" & ws.Rows.Count).End(xlUp).Row
LC = ws2.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Set rng = ws2.Range(ws2.Cells(1, 1), ws2.Cells(LR, LC))
rng.SpecialCells(xlCellTypeVisible).Copy
ws2.Range("D12").PasteSpecial xlPasteValues
End Sub
Would like to create a Macro to loop through all of the sheets in the workbook and select all the data from each worksheet and then paste said data into a single consolidate table on the "Master" sheet. All sheets have the same column heading to Column "AB".
Currently tried using this code but I have been unable to get anything to paste over onto the Master worksheet. Might be overthinking setting the range each tab.
Just looking for a simple solution to copy all active data from each sheet and paste it into one sheet so that is its all consolidated.
Thanks in advance!
Sub CombineData()
Dim wkstDst As Worksheet
Dim wkstSrc As Worksheet
Dim WB As Workbook
Dim rngDst As Range
Dim rngSrc As Range
Dim DstLastRow As Long
Dim SrcLastRow As Long
'Refrences
Set wkstDst = ActiveWorkbook.Worksheets("Master")
'Setting Destination Range
Set rngDst = wkstDst.Cells(DstLastRow + 1, 1)
'Loop through all sheets exclude Master
For Each wkstSrc In ThisWorkbook.Worksheets
If wkstSrc.Name <> "Master" Then
SrcLastRow = LastOccupiedRowNum(wkstSrc)
With wkstSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLastRow, 28))
rngSrc.Copy Destination:=rngDst
End With
DstLastRow = LastOccupiedRowNum(wkstDst)
Set rngDst = wkstDst.Cells(DstLastRow + 1, 1)
End If
Next wkstSrc
End Sub
Throwing another method into the mix. This does assume that the data you are copying has as many rows in column A as it does in any other column. It doesn't require your function.
Sub CombineData()
Dim wkstDst As Worksheet
Dim wkstSrc As Worksheet
Dim rngSrc As Range
Set wkstDst = ThisWorkbook.Worksheets("Master")
For Each wkstSrc In ThisWorkbook.Worksheets
If wkstSrc.Name <> "Master" Then
With wkstSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 28)
rngSrc.Copy Destination:=wkstDst.Cells(Rows.Count, 1).End(xlUp)(2)
End With
End If
Next wkstSrc
End Sub
You have copied this from somewhere else and you have forgotten to copy the function that gets the last row of a worksheet, namely this one LastOccupiedRowNum
So add this function to the same module and the code should work. Please don't forget to mark this as the right answer if it did work:
Function LastOccupiedRowNum(Optional sh As Worksheet, Optional colNumber As Long = 1) As Long
'Finds the last row in a particular column which has a value in it
If sh Is Nothing Then
Set sh = ActiveSheet
End If
LastOccupiedRowNum= sh.Cells(sh.Rows.Count, colNumber).End(xlUp).row
End Function
Try finding the last row dynamically, rather than using .cells
Dim lrSrc as Long, lrDst as Long, i as Long
For i = 1 to Sheets.Count
If Not Sheets(i).Name = "Destination" Then
lrSrc = Sheets(i).Cells( Sheets(i).Rows.Count,"A").End(xlUp).Row
lrDst = Sheets("Destination").Cells( Sheets("Destination").Rows.Count, "A").End(xlUp).Row
With Sheets(i)
.Range(.Cells(2,"A"), .Cells(lrSrc,"AB")).Copy Sheets("Destination").Range(Sheets("Destination").Cells(lrDst+1,"A"),Sheets("Destination").Cells(lrDst+1+lrSrc,"AB"))
End With
End If
Next i
This should replace your sub and the related function.