Lengthy title but hopefully I can explain. What I am wanting to do is Copy/Paste values from active Workbook into another Workbook contained in the same directory "folder" as the active. I need the range of the copy to be dynamic in the sense that if I add lines to the current range, I want the code to automatically pick this up and not have to manually amend the range in the code.
I managed to find and slightly some code on StackOverflow which does what I need statically, but I have no idea how to add the various "dynamic" needs as my VBA knowledge is unfortunately not advanced enough. If you are able to assist, thanks very much in advance!
Code:
Public Sub CopyData()
Dim x As Workbook
Dim y As Workbook
Dim vals As Variant
Dim RemoveRows
Below is where I need the "Path" of the new Workbook to be dynamic. I thought maybe along the lines of Application.ActiveWorkbook.Path to find the path, as I've seen that before, but I couldn't really get it to work. It then also needs to add the filename extension of the destination Workbook, which I have specified on "Sheet 1" in cell F2 of the Active Workbook. ie the destination Workbook to open would be "ActiveWorkbook.Path + Sheet 1 cell F2 + .xls" if that makes sense. The reason for cell F2 is so that I can use this code with other Workbook names.
'Open workbook first:
Set x = Workbooks.Open("PATH")
Continue through code.
Set y = ThisWorkbook
Below Range is what I need to also be dynamic, ideally it would look in column A (starting in row 4), and create a copy/store range for all columns AP until the first blank cell is located in A (ie exactly as per below, but the 13 should automatically increase to say 15 if I add 2 more rows with text in column A.
'Store values in a variable:
vals = y.Sheets("Sheet1").Range("A4:P13").Value
Continue through code (paste/variable assign would need to be the exact same range as vals above except offset up by 2, ie should be A2 to P11 or P13 if rows added).
'Use the variable to assign a value to the other file/sheet:
x.Sheets("Sheet2").Range("A2:P11").Value = vals
'Delete Zero Rows
Set x = ActiveWorkbook
x.Sheets("Sheet2").Activate
For RemoveRows = Range("K65536").End(xlUp).Row To 1 Step -1
If Cells(RemoveRows, 11).Value = 0 Then Rows(RemoveRows).EntireRow.Delete
Next RemoveRows
'Copy Paste Values Again to Sheet 1 to ensure formatting uncompromised
vals = x.Sheets("Sheet2").Range("A2:P1000").Value
x.Sheets("Sheet1").Range("A2:P1000").Value = vals
x.Sheets("Sheet2").Cells.Clear
x.Sheets("Sheet1").Activate
'Close x:
If x.Saved = False Then
x.Save
End If
x.Close
End Sub
For the first question relating to the path, you are almost there, you just need to build the full string. The Application.activeworkbook.path returns the string that point to the directory of the activeworkbook, so you just need to addon the name of the file
For the dynamic ranges, you can use the Range.End property
For the transfer between worksheets/books I would suggest using the Range.Copy/paste properties. when pasting a range, you just need to specify the top left cell and excel will take care of the rest
I've made a few updates to make the worksheet references more explicit, avoid .activate, and a few other changes, but something like the below should do it:
Public Sub CopyData()
Dim x As Workbook
Dim y As Workbook
Dim xWs1 As Worksheet
Dim xWs2 As Worksheet
Dim yWs As Worksheet
Dim vals As Range
Dim newVals As Range
Dim RemoveRows
Dim Path As String
'build the Path
Path = Application.ActiveWorkbook.Path & "\file.xlsx" 'as an alternative you could use the Application.FileDialog(msoFileDialogOpen) to promt the user to select the file
'Open workbook first:
Set x = Workbooks.Open(Path)
Set xWs1 = x.Sheets("Sheet1")
Set xWs2 = x.Sheets("Sheet2")
Set y = ThisWorkbook
Set yWs = y.Sheets("Sheet1")
'reference values by a range:
Set vals = yWs.Range("A4:P" & yWs.Range("A4").End(xlDown).Row)
'copy/paste the range other file/sheet:
vals.Copy xWs2.Range("A2")
'Delete Zero Rows
For RemoveRows = xWs2.Range("A2").End(xlDown).Row To 2 Step -1
If xWs2.Cells(RemoveRows, 11).Value = 0 Then
xWs2.Rows(RemoveRows).EntireRow.Delete
End If
Next RemoveRows
'Copy Paste Values Again to Sheet 1 to ensure formatting uncompromised
Set newVals = xWs2.Range("A2:P" & xWs2.Cells(1048576, 1).End(xlUp).Row)
newVals.Copy xWs1.Range("A2")
xWs2.Rows.EntireRow.Delete
xWs1.Activate
'Close x:
If x.Saved = False Then
x.Save
End If
x.Close
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.