I'm trying to copy and paste a variable range from "Sheet 1" into "Sheet 2" and offset the cell that I'm pasting into Sheet 2 by one row. I'm doing this so I can add more data into Sheet 2 without overwriting data already pasted.
I created the desired copying ranges for sheet 1:
Dim rw As Range
Set rw = Sheets("Sheet 1").Range(Range("A4"), Range("A4").End(xlDown))
Dim clm As Range
Set clm = Sheets("Sheet 1").Range(Range("A4"), Range("A4").End(xlToRight))
Now I want to paste the range into Column A from Sheet 2 but under the last row used.
I got the following code to work to paste into cell A3 of Sheet 2:
Sheets("Sheet 1").Range(rw, clm).Copy Sheets("Sheet 2").Range("A3")
But I don't know how to offset by 1 row under every time.
Any help would be appreciated!
Copy Data From Table
A Quick Fix
Sub CopyData()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
Dim srg As Range
With sws.Range("A4")
Set srg = sws.Range(.End(xlDown), .End(xlToRight))
End With
Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
Dim dfCell As Range
Set dfCell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
srg.Copy dfCell
End Sub
I don't use VBA much at all. I found some code online that has me moving in the right direction, however, I'm struggling how to copy just the values in column "A" rather than copying all the rows. The bold/italic area is where I believe the problem lies.
`For i = 2 To a
If Sheets(Range("O1").Value).Cells(i, 9).Value = "False" Then
***Sheets(Range("O1").Value).Rows(i).Copy***
Worksheets("Product_Lookup").Activate
B = Worksheets("Product_Lookup").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Product_Lookup").Cells(B + 1, 1).Select
ActiveSheet.Paste
Worksheets("Product_Lookup").Activate`
Using Variables
By using variables, your code will become more readable (understandable).
Activating and selecting often leads to mistakes and it severely slows down the operation. Avoiding this is
illustrated in this post.
The following illustrates the Workbook-Worksheet-Range hierarchy.
' The usual approach is e.g.:
'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
'Dim iws As Worksheet: Set iws = wb.Worksheets("Sheet1")
' Note that 'iws' could actually be 'dws', we don't know!
Dim iws As Worksheet: Set iws = ActiveSheet ' unknown worksheet?
Dim wb As Workbook: Set wb = iws.Parent
Dim sws As Worksheet
On Error Resume Next ' check if the worksheet exists
Set sws = wb.Worksheets(CStr(iws.Range("O1").Value)) ' it may be empty!
On Error GoTo 0
If sws Is Nothing Then Exit Sub ' the worksheet doesn't exist
Dim dws As Worksheet: Set dws = wb.Worksheets("Product_Lookup")
Dim dCell As Range
Set dCell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
For i = 2 To a
If CStr(sws.Cells(i, "I").Value) = "False" Then
sws.Cells(i, "A").Copy dCell
' If you only need values then the following is more efficient:
'dCell.Value = sws.Cells(i, "A").Value
Set dCell = dCell.Offset(1)
End If
Next i
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
On the below code, I need to Autofit range then set RowHeight for that range to be not less than 40.
The line code of Autofit r.EntireRow.AutoFit has no effect at all even after I commented RowHeight code.
On contrary, RowHeight code works.
In advance, grateful for all useful comment and answer.
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").Resize(srg.Rows.Count, srg.Columns.Count)
drg.Value = srg.Value
srg.Copy
drg.PasteSpecial xlPasteColumnWidths
Dim r As Range
For Each r In drg.Rows
r.EntireRow.AutoFit 'Has no effect
' If r.RowHeight < 40 Then r.RowHeight = 40 'This line works
Next r
I replaced r.EntireRow.AutoFit with r.WrapText = True and that solved the problem.
I have 2 different excel files, stored in C:\Test:
Book1.xlsx, with Sheet1 (data in the Sheet1 is changing, not constant data-range, but always starts from A1 cell)
Book2.xlsm, with Sheet2 (empty)
Every time after opening Book2, I need data from Sheet1 of Book1 to be automatically copied into Sheet2 of Book2.
Update:
I tried the following vba code (researched online from Excel Forum)
Private Sub Workbook_Open()
Application.EnableEvents = False
Dim swb As Workbook, Lr As Long, LC As Long, sws As Worksheet
Dim dCell As Range, srg As Range, dwb As Workbook, dws As Worksheet
Set swb = Workbooks.Open("C:\Test\AAA\Book1.xlsx")
Set sws = swb.Worksheets("Sheet1")
Lr = sws.Cells(Rows.Count, 1).End(xlUp).Row
LC = sws.Cells(1, Columns.Count).End(xlToLeft).Column
Set srg = sws.Range(Cells(1, 1), Cells(Lr, LC))
Set dwb = ThisWorkbook
Set dws = dwb.Worksheets("Sheet2")
Set dCell = dws.Range("A1")
srg.Copy dCell
swb.Close SaveChanges:=False
dwb.Save
Application.EnableEvents = True
End Sub
But, the problem with this - that if I delete a few records after the 1st one from Sheet1 of Book1, then - these deleted records still appear in the Sheet2 of Book2!
I am not great in vba, it's just a part of my whole project
Sorry for these questions
Update 2:
When I have the following in Sheet1, Book1:
Then, after opening Sheet2, Book2, I see (which is correct, what I expected):
But, if I'll delete records in Sheet1, Book1 (starting from the 2nd):
Then, after opening Sheet2, Book2 I will still see those deleted from Book2 records (while I expect them to be gone):
When the destination sheet has more data than the source sheet, you will need to clear it before you copy over the data. You could do it with the Range-method ClearContents:
Set dws = dwb.Worksheets("Sheet2")
dws.Usedrange.ClearContents
Set dCell = dws.Range("A1")
srg.Copy dCell
As it seems that you are copying the data of the whole sheet, an alternative could be to remove the sheet in ThisWorkbook and copy the sheet itself:
' Delete Sheet2 (if present)
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Sheet2").Delete
Application.DisplayAlerts = True
On Error GoTo 0
' Copy Sheet from sourceWorkbook
sws.Copy after:=ThisWorkbook.Sheets(1)
ActiveSheet.Name = "Sheet2" ' Copied sheet gets the active sheet automatically.
Clear Range Below Copied Data
Private Sub Workbook_Open()
Application.EnableEvents = False
Dim swb As Workbook, sws As Worksheet, srg As Range, LR As Long, LC As Long
Dim dwb As Workbook, dws As Worksheet, dCell As Range
Set swb = Workbooks.Open("C:\Test\AAA\Book1.xlsx")
Set sws = swb.Worksheets("Sheet1")
LR = sws.Cells(sws.Rows.Count, 1).End(xlUp).Row
LC = sws.Cells(1, sws.Columns.Count).End(xlToLeft).Column
Set srg = sws.Range(sws.Cells(1, 1), sws.Cells(LR, LC))
Set dwb = ThisWorkbook
Set dws = dwb.Worksheets("Sheet2")
Set dCell = dws.Range("A1")
srg.Copy dCell
With dCell.Resize(, srg.Columns.Count)
.Resize(.Worksheet.Rows.Count - .Row - srg.Rows.Count + 1) _
.Offset(srg.Rows.Count).Clear
End With
swb.Close SaveChanges:=False
dwb.Save
Application.EnableEvents = True
End Sub