I have code where I process and eliminate Mass Spectrometry data (which works).
I have another command to copy that data from its worksheet and to paste it to the same sheet with the Macro (Sheet1). It pastes a line of code to the worksheet instead of the information in proteinGroups.
Set wb = Workbooks.Open("C:\Users\X241066\Downloads\PGroupTest.xlsm")
myFile = "C:\Users\X241066\Desktop\Pgroup\proteinGroups.xls"
Workbooks.Open myFile
Worksheets("proteinGroups").Copy
Workbooks("ProteinGroups.xls").Close SaveChanges:=True
wb.Activate
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("E1")
Application.CutCopyMode = False
Every iteration of commands I tried pastes the data to a new random workbook.
Copy the UsedRange to Another Workbook
Worksheet.UsedRange property
Range.Copy method
On the Worksheet.Copy method page, the following is stated:
If you don't specify either Before or After, Microsoft Excel creates a new workbook that contains the copied Worksheet object.
Option Explicit
Sub CopyProteinGroups()
' Source (Copy FROM (Read))
Dim swb As Workbook
Set swb = Workbooks.Open("C:\Users\X241066\Desktop\Pgroup\proteinGroups.xls")
Dim sws As Worksheet: Set sws = swb.Worksheets("ProteinGroups")
Dim srg As Range: Set srg = sws.UsedRange
' Destination (Copy TO (Write))
Dim dwb As Workbook
Set dwb = Workbooks.Open("C:\Users\X241066\Downloads\PGroupTest.xlsm")
Dim dws As Worksheet: Set dws = dwb.Worksheets("Sheet1")
Dim dfCell As Range: Set dfCell = dws.Range("E1")
' Copy
srg.Copy dfCell
' Save and/or Close
swb.Close SaveChanges:=False ' no need to save; it was only read from
' dwb.Close SaveChanges:=True ' save when you're done; it was written to
End Sub
Related
I have several simple lines of code that should paste a section of data into the cell I selected in Sheet2:
Sub asdf()
Sheets("Sheet1").Range("A1:D5").Copy
Worksheets("Sheet2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Which just gives me application or object-defined errors.
Note: I also tried using ActiveCell which just causes this:
What is stranger is that it worked beforehand. Maybe because of saving issues?
Copy Range Values to 'the Active Cell' of Another Worksheet
Option Explicit
Sub CopyRangeValues()
' Define constants:
' Source (read (copy) from)
Const sName As String = "Sheet1"
Const srgAddress As String = "A1:D5"
' Destination (write (paste) to)
Const dName As String = "Sheet2"
' Reference our workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the source worksheet ('sws') and the source range ('srg').
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim srg As Range: Set srg = sws.Range(srgAddress)
' Reference the destination worksheet ('dws').
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
' 2.) To reference the active cell in the destination worksheet,
' previously make sure that the destination worksheet is active.
' 1.) To activate the destination worksheet, previously make sure
' that our workbook is active.
Application.ScreenUpdating = False
' 1.) Make sure that our workbook is active.
Dim awb As Workbook: Set awb = ActiveWorkbook
If Not wb Is awb Then wb.Activate
' 2.) Make sure that the destination worksheet is active.
Dim ash As Object: Set ash = wb.ActiveSheet ' could be a chart
If Not dws Is ash Then dws.Activate
' Reference the destination first cell ('dfCell'), the active cell
' in the destination worksheet, using 'Application.ActiveCell'.
Dim dfCell As Range: Set dfCell = ActiveCell
' Reference the destination range ('drg'), the destination first cell
' resized by the number of rows and columns of the source range.
Dim drg As Range: Set drg = dfCell.Resize(srg.Rows.Count, srg.Columns.Count)
' Copy (by assignment) the values from the source range
' to the destination range.
drg.Value = srg.Value
' Activate the initial active sheet in our workbook
' (if it wasn't the destination worksheet).
If Not dws Is ash Then ash.Activate
' Activate the initial active workbook (if it wasn't our workbook).
If Not wb Is awb Then awb.Activate
Application.ScreenUpdating = True
' Inform.
MsgBox "Copied the values from the range '" & srgAddress _
& "' in worksheet '" & sName & "' to the range '" & drg.Address(0, 0) _
& "' in worksheet '" & dName & "' of the workbook '" & wb.Name & "'.", _
vbInformation
End Sub
I am trying to run a command to open all workbooks from a query. Once open I am looking to edit the same cells in each tab for each workbook. The code below, works to open, and edit each workbook in the query when trying to update to run through each active sheet in the workbooks it will only update the first sheet. The second set is what I have tried to have it loop through each sheet.
Open and update the first active sheet in each workbook
Sub UpdateMetrics()
Dim wb As Workbook
For Each Cell In Selection
Set wb = Workbooks.Open(Cell.Value)
Range("A1").Value = "Test"
wb.Save
wb.Close
Next
End Sub
Loop through each sheet:
Sub UpdateMetricsTest()
Dim wb As Workbook
Dim ws As Worksheet
For Each Cell In Selection
Set wb = Workbooks.Open(Cell.Value)
For Each ws In Worksheets
Range("A1").Value = "Test"
Next ws
Next
End Sub
Loop Through Each Worksheet of Each Workbook
This will write a value (Test) into the same cell (A1) of each worksheet of each file (workbook) that is opened. The list of the file paths (e.g. C:\Test\Test1.xlsx) is in a column (A; more accurately A2:ALastRow) of a worksheet (Sheet1) of the workbook containing this code (ThisWorkbook).
Option Explicit
Sub UpdateMetrics()
' Source (read from)
Const sName As String = "Sheet1"
Const sCol As String = "A"
Const sfRow As Long = 2
' Destination (write to)
Const dCellAddress As String = "A1"
Const dCellValue As String = "Test"
' Reference the source (one-column) range containing the file paths.
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
Dim srg As Range: Set srg = sws.Range(sws.Cells(sfRow, sCol), _
sws.Cells(sws.Rows.Count, sCol).End(xlUp)) ' ('A2:ALastRow')
Application.ScreenUpdating = False
Dim sCell As Range
Dim dwb As Workbook
Dim dws As Worksheet
Dim dFilePath As String
' Loop through the cells of the source range.
For Each sCell In srg.Cells
dFilePath = CStr(sCell.Value) ' Tolerate error values by using 'CStr'.
If Len(dFilePath) > 0 Then ' cell is not blank
If Len(Dir(dFilePath)) > 0 Then ' file exists
On Error Resume Next ' Attempt to open the file:
Set dwb = Workbooks.Open(dFilePath)
On Error GoTo 0
If Not dwb Is Nothing Then ' file was opened
' Loop through the worksheets in the current workbook...
For Each dws In dwb.Worksheets
' ... and write the value to each worksheet's cell.
dws.Range(dCellAddress).Value = dCellValue
Next dws
dwb.Close SaveChanges:=True
Set dwb = Nothing
'Else ' file was not opened; do nothing
End If
'Else ' file does not exist; do nothing
End If
'Else ' cell is blank; do nothing
End If
Next sCell
Application.ScreenUpdating = True
' Inform.
MsgBox "Metrics updated.", vbInformation
End Sub
So I have some Workbooks (2020 & 2021).
Each have 12 Sheets which are based on Month Name eg Jan, Feb, March.
So I would like to write a code to paste data from Sheet("Jan") to Sheet("Jan") and so on from the Workbook 2020 to Workbook 2021 in simple codes.
To do so I have written 25 Codes 12 to Copy and 12 to paste and one Master code to Run all of them.
Is there better alternative to Copy paste them by shortest easiest possible code.
Can I do it with loop. Match Sheets Name and Paste from One Workbook to Another.
Below is example of Code I have written.
Sub Master_Code()
Call_Jan_Copy
Call_Feb_Copy
Call_Mar_Copy
Call_Apr_Copy
Call_May_Copy
Call_Jun_Copy
Call_Jul_Copy
Call_Aug_Copy
Call_Sep_Copy
Call_Oct_Copy
Call_Nov_Copy
Call_Dec_Copy
End Sub
Sub Jan_Copy()'Code-1
Sheets("Jan").Select
ActiveSheet.Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Call Jan_Paste
End Sub
Sub Jan_Paste()'Code-2
Sheets("Jan").Select
ActiveSheet.Range("A1").Select
ActiveSheet.Range("A1048576").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial xlPasteAll
Application.CutCopyMode = False
End Sub'
Append Worksheet Data
Option Explicit
Sub AppendLastYear()
Const sFilePath As String = "C:\Test\2020.xlsm"
Dim dwb As Workbook: Set dwb = ThisWorkbook
Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
Application.ScreenUpdating = False
Dim sws As Worksheet
Dim srg As Range
Dim dws As Worksheet
Dim dfCell As Range
For Each dws In dwb.Worksheets
Set dfCell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
Set sws = swb.Worksheets(dws.Name)
With sws.Range("A1").CurrentRegion
Set srg = .Resize(.Rows.Count - 1).Offset(1)
End With
srg.Copy dfCell
Next dws
swb.Close SaveChanges:=False
Application.ScreenUpdating = True
MsgBox "Last year appended.", vbInformation
End Sub
Don't rely on ActiveSheet or ActiveWorkbook. Use references instead
Something like
Sub CopyMonths()
Dim wbSrc As Workbook
Dim wbDst As Workbook
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Set wbSrc = Application.Workbooks("NameOfYourSourceBook.xlsx/m/b") ' Update to your book name, including extension
Set wbDst = Application.Workbooks("NameOfYourDestinationBook.xlsx/m/b") ' Update to your book name, including extension
For Each wsSrc In wbSrc.Worksheets
Set wsDst = wbDst.Worksheets(wsSrc.Name)
wsSrc.UsedRange.Copy
wsDst.Cells(1, 1).PasteSpecial xlPasteAll
Next
End Sub
You might want to consider what to do if
Source wb has more sheets (test for some distinguishing feature before copying)
Dest wb is missing one of the sheets (test for existing, create if missing)
There is existing data on some dest sheets (clear sheet, or paste below)
I copy data from workbook to another workbook ,copying of single contiguous selection works without problem.
But, If I copied two selections (using CTRL) , even adjacent , nothing copied to the destination workbook (with no error raised).
How to adapt the below code to make it Copy non-contiguous selection from workbook to another?
In advance, grateful for useful answer and comments.
Dim wb As Workbook: Set wb = ThisWorkbook 'Source Workbook
Dim srg As Range: Set srg = wb.ActiveSheet.Range(Selection.Address)
Dim wb1 As Workbook: Set wb1 = Workbooks.Add 'Destination Workbook
Dim drg As Range: Set drg = wb1.Sheets(1).Range("A1")
srg.Copy drg
srg.Copy
drg.PasteSpecial Paste:=xlPasteColumnWidths
Dim r As Range
For Each r In drg.Rows
r.WrapText = True
If r.RowHeight < 40 Then r.RowHeight = 40 'This line works
Next r
This answer refers to #karma
Just I need to copy columns width then copy values after it.
srg.Copy
drg.PasteSpecial Paste:=xlPasteColumnWidths
srg.Copy drg
I am trying to copy data from a table into another sheet.
Sub ListOfSquads()
Sheets("Apontamentos").Select
Range("Apontamentos[[#Headers],[Área]]").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Sheets("Squads").Select
ThisWorkbook.Sheets("Squads").Columns("A:A").ClearContents
ThisWorkbook.Sheets("Squads").Range("A1").Select
ThisWorkbook.Sheets("Squads").Paste
Application.CutCopyMode = False
End Sub
The ClearContents command is making a
Run-Time error '1004'> Application-defined or object-defined error.
Copy Excel Table Column (ListColumn.Range)
In your code, when you did the ClearContents, you actually removed the copied range from the clipboard. As Tim Williams suggested in the comments, you had to move the ClearContents line before the Selection.Copy line and appropriately rearrange the Select lines.
Using Select is a Macro Recorder 'thing' and is best avoided in your code, as described
in this legendary post.
This code uses the Range.Copy method.
Option Explicit
Sub ListOfSquads()
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Worksheets("Apontamentos")
Dim stbl As ListObject: Set stbl = sws.ListObjects("Apontamentos")
Dim slcl As ListColumn: Set slcl = stbl.ListColumns("Área")
Dim scrg As Range: Set scrg = slcl.Range
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets("Squads")
dws.Columns("A").ClearContents
Dim dfCell As Range: Set dfCell = dws.Range("A1")
' Copy
scrg.Copy dfCell
End Sub