a guest Feb 20th, 2019 80 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
- Sub Sheet2_Button1_Click()
- ' Sheet2_Button1_Click Macro
- Dim TargetSht As Worksheet, SourceSht As Worksheet, SourceCol As Integer, SourceCells As Range
- 'If an error occurs skip code to the Err-Hanlder line and the display the error message.
- On Error GoTo Err_Handler
- 'This is the sheet where your copy information from. Change "Sheet1" to the name of your soure sheet
- Set SourceSht = ThisWorkbook.Sheets("Sheet1")
- 'Name of the sheet where data is to be copied to. Rename Sheet2 to the name of your target sheet
- Set TargetSht = ThisWorkbook.Sheets("Sheet2")
- 'This is the cells you will copy data from. This is targeting cells B1 to the last used cell in column B
- Set SourceCells = SourceSht.Range("c3:c0" & SourceSht.Range("c4").End(xlUp).Row)
- 'This is finding the next column available in the target sheet. It assumes dates will be in row 1 and data in row 2 down
- If TargetSht.Range("A1").Value = "" Then
- 'Cell A1 is blank so the column to put data in will be column #1 (ie A)
- SourceCol = 1
- ElseIf TargetSht.Range("IV1").Value <> "" Then
- 'Cell IV1 has something in it so we have reached the maximum number of columns we can use in this sheet.
- 'Dont paste the data but advise the user.
- MsgBox "There are no more columns available in the sheet " & TargetSht.Name, vbCritical, "No More Data Can Be Copied"
- 'stop the macro at this point
- Exit Sub
- 'cell A1 does have data and we havent reached the last column yet so find the next available column
- SourceCol = TargetSht.Range("IV1").End(xlToLeft).Column + 1
- End If
- 'Put in the date in the appropriate column in row 1 of the target sheet
- TargetSht.Cells(1, SourceCol).Value = Format(Date, "DD/MM/YYYY")
- 'We can now start copying data. This will copy the cells in column B from the source sheet to row 2+ in the target sheet
- SourceCells.Copy TargetSht.Cells(2, SourceCol)
- Exit Sub 'This is to stop the procedure so we dont display the error message every time.
- MsgBox "The following error occured:" & vbLf & "Error #: " & Err.Number & vbLf & "Description: " & Err.Description, _
- vbCritical, "An Error Has Occured", Err.HelpFile, Err.HelpContext
- End Sub
- Sub Button3_Click()
- ' Button3_Click Macro
- Selection.Insert Shift:=xlDown
- Application.CutCopyMode = False
- End Sub
RAW Paste Data