Forum Discussion
Vba
You can achieve this by writing a VBA macro to open the source workbook, copy the second row from the specified sheet, and paste it into the next available row in the destination sheet. Here's the VBA code for your requirement:
VBA Macro to Copy and Paste Data
Sub CopySecondRow()
Dim srcWb As Workbook
Dim srcWs As Worksheet
Dim destWb As Workbook
Dim destWs As Worksheet
Dim lastRow As Long
Dim srcFilePath As String
Dim destFileName As String
' Define file paths
srcFilePath = "C:\Users\YourUsername\Desktop\new folder 16\1-2days allocation.xlsx" ' Update with the correct path
destFileName = "y1737.xlsx"
' Open the source workbook
On Error Resume Next
Set srcWb = Workbooks.Open(srcFilePath)
If srcWb Is Nothing Then
MsgBox "Source workbook not found!", vbExclamation
Exit Sub
End If
On Error GoTo 0
' Set source worksheet
Set srcWs = srcWb.Sheets("21 allocation")
' Activate the destination workbook
Set destWb = ThisWorkbook ' Assuming the macro runs from 'y1737' workbook
Set destWs = destWb.Sheets("allocation")
' Find the last used row in the destination sheet
lastRow = destWs.Cells(destWs.Rows.Count, 1).End(xlUp).Row + 1
' Copy the second row (A2: last column)
srcWs.Rows(2).Copy
' Paste into the next available row in the destination sheet
destWs.Cells(lastRow, 1).PasteSpecial Paste:=xlPasteValues
' Enter "y1737" in the adjacent column
destWs.Cells(lastRow, destWs.Cells(1, Columns.Count).End(xlToLeft).Column + 1).Value = "y1737"
' Close the source workbook without saving
srcWb.Close False
' Clear clipboard to release memory
Application.CutCopyMode = False
' Notify user
MsgBox "Data copied successfully!", vbInformation
End Sub
Steps to Use the Macro
1. Open the "y1737.xlsx" workbook.
2. Press ALT + F11 to open the VBA Editor.
3. Go to Insert > Module.
4. Paste the above VBA code.
5. Update the srcFilePath with the actual path of your "1-2days allocation.xlsx" file.
6. Run the macro (CopySecondRow).
This macro will:
Open the "1-2days allocation.xlsx" workbook.
Copy the second row from "21 allocation".
Paste it into the next available row in "allocation" of "y1737.xlsx".
Enter "y1737" in the adjacent column.
Close the source workbook without saving changes.
Let me know if you need any modifications!
2 Replies
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim cbValues As String
Dim optionLabelsRange As Range
Dim checkboxLinksRange As Range
Dim monitoredColumn As Long
Dim currentRow As Long
Dim i As Long
Set ws = Me
monitoredColumn = 7 ' Column G
' Define your option labels and linked checkbox cells
Set optionLabelsRange = ws.Range("B2:B10") ' Options for all clients
Set checkboxLinksRange = ws.Range("Z2:Z10") ' Linked cells for checkboxes' Trigger only when a single cell is changed in Column G
If Not Intersect(Target, ws.Columns(monitoredColumn)) Is Nothing Then
If Target.Cells.Count = 1 And Target.Value <> "" Then
currentRow = Target.Row' Store checkbox selections for the *previous* client
If currentRow > 2 Then
cbValues = ""
For i = 1 To checkboxLinksRange.Cells.Count
If checkboxLinksRange.Cells(i).Value = True Then
cbValues = cbValues & optionLabelsRange.Cells(i).Value & ", "
End If
Next i' Trim trailing comma and space
If Len(cbValues) > 2 Then cbValues = Left(cbValues, Len(cbValues) - 2)' Save in Column H of previous client row
ws.Cells(currentRow - 1, "H").Value = cbValues
End If' Reset all checkboxes
checkboxLinksRange.Value = False
End If
End If
End SubYou've accidentally started a new post, you have not answered an existing question.
