Is there a way to copy multiple selected cells from excel as shown below? It always copies the whole range from the first selected cell to the last cell, rather than copying the values from selected cells.
A VBA code will be useful.
The following will help, this will copy the specified ranges to the clipboard so you can paste them into Notepad:
Sub CopyToClipboard()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
'declare and set the worksheet you are working with, amend as required
ws.Range("B11:B12,B14,B18,B20,B22").Copy
'copy range to clipboard
End Sub
UPDATE:
A possible workaround for this would be to use a Temp worksheet and add the selected values into it and then copy that range into the Clipboard, a little long winded, but it would work:
Sub CopyToClipboard()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
'declare and set the worksheet you are working with, amend as required
Dim work As Worksheet
Dim arr() As Variant
i = 0
For Each work In ThisWorkbook.Worksheets
If work.Name = "Temp" Then
Application.DisplayAlerts = False
work.Delete
Application.DisplayAlerts = True
End If
Next
'if Temp worksheet exists then delete it
For Each c In Selection
i = i + 1
ReDim Preserve arr(1 To i)
arr(i) = c.Value
Next
'above add the values from selection to an array
Set ws2 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws2.Name = "Temp"
'add a temporary worksheet
For x = LBound(arr) To UBound(arr)
ws2.Cells(x, 1).Value = arr(x)
Next x
'copy values from array into temp worksheet
LastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
ws2.Range("A1:A" & LastRow).Copy
'copy continuous range from Temp worksheet
End Sub
Related
I have 100 worksheets in a workbook. In each sheet, there are blank rows for the first rows. For some sheets, the 8th row is where the data begins. For some sheets data begins on the 9th or 10th.
My code goes to the first row that has a value and then offset one row up. Then i need it to delete.
My code works on a single sheet just fine, but when i try to iterate through all the worksheets in the workbook, it doesn't go beyond the active worksheet.
What can i do to iterate through the worksheets?
Sub To_Delete_Rows_In_Range()
Dim iCntr
Dim rng As Range
Dim wb As Workbook
Set wb = ActiveWorkbook
For Each Ws In wb.Worksheets
Set rng = Range("A1", Range("A1").End(xlDown).Offset(-1, 0))
For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
Rows(iCntr).EntireRow.Delete
Next
Next Ws
End Sub
Added Ws. in front of your range so it knows to change with the sheet.
Sub To_Delete_Rows_In_Range()
Dim iCntr
Dim rng As Range
Dim wb As Workbook
Set wb = ActiveWorkbook
For Each Ws In wb.Worksheets
Set rng = Ws.Range("A1", Ws.Range("A1").End(xlDown).Offset(-1, 0))
For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
Ws.Rows(iCntr).EntireRow.Delete
Next
Next Ws
End Sub
Try a different approach, delete the first row over and over gain, until the content of A1 is not blank:
Do Until Ws.Range("A1").Value <> vbNullString
Ws.Rows(1).Delete
Loop
I have a code that should restore range formatting after applying few step.
Sub MyCode()
Sheets("My sheet").ListObjects("My Table").DataBodyRange.Copy
...
refreshing connection and calling function that applies stored formulas to table columns
...
Sheets("My sheet").[A10].PasteSpecial Paste:=xlPasteFormats
End sub
I got error PasteSpecial method on range failed
If I paste immediately, it works.
Is it possible to save range formatting as variable?
Here is an example on how to use variables to store the copy method and use it later. You can set the range to a variable CopyRange and use CopyRange.Copy to store it and later you can use it as the range was stored in the CopyRange and not lost along the way due to other processes running down the line.
Option Explicit
Sub CopyDataToTemplate()
Dim ws As Worksheet
Dim srcWB As Workbook
Dim destWB As Workbook
Dim srcWS As Worksheet
Dim destWS As Worksheet
Dim CopyRange As Variant
Dim i As Long, j As Long
Dim srcLRow As Long, destLRow As Long
Set destWB = Excel.Workbooks("DOLine_example.xlsx")
Set srcWB = ActiveWorkbook
Set srcWS = srcWB.ActiveSheet
Set destWS = destWB.Sheets("DOLine")
srcLRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
destLRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
'loop through column 1 to 19
For i = 1 To 19
For j = 1 To 13
'loop through columns
If destWS.Cells(3, i).value = srcWS.Cells(1, j).value Then
' Copy column B to Column D as written in your code above
Set CopyRange = srcWS.Range(Cells(2, j), Cells(srcLRow, j))
CopyRange.Copy
' paste columns from one wb to Columns to another wb
destWS.Cells(destLRow, i).PasteSpecial Paste:=xlPasteAll, Transpose:=False
Application.CutCopyMode = False
End If
Next j
Next i
Application.ScreenUpdating = True
MsgBox "Process completed!", vbInformation
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.
currently the code below will copy two spreadsheets into the macro sheet.
Problem: I want to use Excel cells to specify a file path (from cell A1, A2 or wherever), a sheet name (from cell B1, B2), and a corresponding specified cell range (in cells C1, C2) instead of having to browse to each file with the Application.
Option Explicit
Sub Sample()
Dim wb1 As Workbook: Set wb1 = ThisWorkbook
Dim wb2 As Workbook
Dim i As Long
Dim wsNew As Worksheet
Dim ws As Worksheet: Set ws = wb1.Sheets("Sheet1")
Dim LastRow
Dim sheetName As String
Dim rangeStart As String
Dim rangeEnd As String
Dim ws2 As Worksheet
Dim CellValueToCopy As String
'declare and set your worksheet with your filenames
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data by finding the last item in Column A
For i = 2 To LastRow 'loop from Row 2 to Last in Sheet1 of this workbook
Set wb2 = Workbooks.Open(ws.Cells(i, "A")) 'open the file stored in Column A of Sheet1 of this workbook
sheetName = ws.Cells(i, "B")
rangeStart = ws.Cells(i, "C")
rangeEnd = ws.Cells(i, "D")
'wb2.Sheets(ws.Cells(i, "B").Value).range(ws.Cells(i, "C").Value).Copy
Set ws2 = wb2.Worksheets(sheetName)
wb1.Sheets.Add
wb1.ActiveSheet.Name = sheetName + "_added"
' the below is a proof of concept to copy the values
' loop through the range rather than just one cell to get the final copy
CellValueToCopy = ws2.Cells(1, 1)
wb1.ActiveSheet.Cells(1, 1) = CellValueToCopy
' close workbook and reset variables
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wsNew = Nothing
Set ws2 = Nothing
Next i
End Sub
How about something like the following, this will loop through your column A, open the given filename, and copy the Range from Column C from the Sheet in Column B and paste into a new sheet in the current workbook:
Option Explicit
Sub Sample()
Dim wb1 As Workbook: Set wb1 = Workbooks("Change from interface to Cell specify range.xlsm")
Dim wb2 As Workbook
Dim i As Long, LastRow As Long
Dim wsNew As Worksheet
Dim ws As Worksheet: Set ws = wb1.Sheets("Sheet1")
'declare and set your worksheet with your filenames, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
For i = 2 To LastRow 'loop from Row 2 to Last in Sheet1 of this workbook
Set wb2 = Workbooks.Open(ws.Cells(i, "A")) 'open the file stored in Column A of Sheet1 of this workbook
wb2.Sheets(ws.Cells(i, "B").Value).Range(ws.Cells(i, "C").Value).Copy
'above specify the sheet from Column B of Sheet1 and the Range from Column C
'if you have starting range at Column C and end range at Column D then the line below will copy the specified range
'wb2.Sheets(ws.Cells(i, "B").Value).Range(ws.Cells(i, "C").Value & ":" & ws.Cells(i, "D").Value).Copy
Set wsNew = wb1.Sheets.Add(After:=wb1.Sheets(wb1.Sheets.Count))
wsNew.Name = "Blah Blah " & (i - 1)
'above add a new sheet and name accordingly, I used the counter i to number the sheets
wsNew.Range("A1").PasteSpecial xlPasteAll
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wsNew = Nothing
Next i
End Sub
I have two separate Excel files. In one of these in Sheet1 is stored infomration about orders and order numbers. Now every time I make a new order I want this information be collected from my order and inserted in to so called "database" workbook. It should identify the last empty row in column A:A in C:\Users\user\Desktop\Order_number.xlsx and insert new values from range ("C6,C17,C10,H18,B32,G32,H6,H9") to the next empty row. Here is the code I came up to but there is some mistake and it is not working. How it can be fixed?
Sub TransferValues465()
Dim wsMain As Worksheet: Set wsMain = ThisWorkbook.ActiveSheet
Dim wsData As Worksheet: Set wsData = Workbooks.Open("C:\Users\user\Desktop\Order_number.xlsx").Sheets("Sheet1")
Dim rngToCopy As Range: Set rngToCopy = wsMain.Range("C6,C17,C10,H18,B32,G32,H6,H9")
Dim c As Long
Dim ar As Range
Dim cl As Range
Dim LastRow As Long
Dim rngDestination As Range
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
'Get the last row in Database sheet:
LastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
Set rngDestination = wsData.Cells(LastRow + 1, 1).Resize(1, 25).Offset(0, 0)
For Each ar In rngToCopy.Areas
For Each cl In ar
c = c + 1
'I used this next line for testing:
' rngDestination.Cells(c).Value = cl.Address
rngDestination.Cells(c).Value = cl.Value
Next
Next
End Sub
A few corrections:
1) Set wsData = Workbooks("C:\Users\user\Desktop\Order_number.xlsx").Sheets("Sheet1") will not work. Either use Set wsData = Workbooks("Order_number.xlsx").Sheets("Sheet1") if the workbook is open. Or you need to open the workbook first.
2) I am not famliar on using Application.WorksheetFunction.CountA(wsData.Range("A:A")) to get the last row. To get the last row in Column A (with the possibility of skipping balnk cells in the middle) use wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row.
3) My preference is to use Copy >> PasteSpecial xlPasteValues with cl.Copy and the following line wsData.Range("A" & C).PasteSpecial xlPasteValues.
Code
Option Explicit
Sub TransferValues465()
Dim wsMain As Worksheet
Dim wbData As Workbook
Dim wsData As Worksheet
Dim rngToCopy As Range
Dim C As Long
Dim ar As Range
Dim cl As Range
Dim LastRow As Long
Dim rngDestination As Range
Set wsMain = ThisWorkbook.ActiveSheet
Application.DisplayAlerts = False
' you need to open the workbook
Set wbData = Workbooks.Open("C:\Users\user\Desktop\Order_number.xlsx")
Set wsData = wbData.Sheets("Sheet1")
Set rngToCopy = wsMain.Range("C6,C17,C10,H18,B32,G32,H6,H9")
'Get the last row in Database sheet:
LastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
C = 1
For Each cl In rngToCopy
cl.Copy
wsData.Cells(LastRow + 1, C).PasteSpecial xlPasteValues
C = C + 1
Next cl
wbData.Close True '<-- close and save the changes made
Application.DisplayAlerts = True '<-- restore settings
End Sub