Forum Home
Press F1
 
Thread ID: 113648 2010-10-29 14:19:00 Creating Macro to copy and paste data into the next empty column esigolf (16054) Press F1
Post ID Timestamp Content User
1148614 2010-10-29 14:19:00 This was posted by Parry in 2008.



Sub HistoricalData()
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( " B1:B " & SourceSht.Range( " B65536 " ).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
Else
'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)

'Advise the user that the process was successful
MsgBox " Data copied successfully! " , vbInformation, " Process Complete "

Exit Sub 'This is to stop the procedure so we dont display the error message every time.
Err_Handler:
MsgBox " The following error occured: " & vbLf & " Error #: " & Err.Number & vbLf & " Description: " & Err.Description, _
vbCritical, " An Error Has Occured " , Err.HelpFile, Err.HelpContext


End Sub

I Have modified it to this:



Sub PointsData()
Dim TargetSht As Worksheet, SourceSht As Worksheet, SourceCol As Integer, SourceCells As Range

'Move the data to the posting column
Sheet115.Select
Range( " AD2:AD21 " ).Select
Selection.Copy
Range( " AE2 " ).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'If an error occurs skip code to the Err-Handler 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 = Sheet115

'Name of the sheet where data is to be copied to. Rename Sheet2 to the name of your target sheet
Set TargetSht = Sheet115

'This is the cells you will copy data from. This is targeting cells AD2 to the last used cell in column B
Set SourceCells = SourceSht.Range( " AE2:AE21 " )

'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( " C1 " ).Value = " " Then
'Cell C1 is blank so the column to put data in will be column #1 (ie A)
SourceCol = 3
ElseIf TargetSht.Range( " V1 " ).Value <> " " Then
'Cell V1 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
Else
'cell C1 does have data and we havent reached the last column yet so find the next available column
SourceCol = TargetSht.Range( " V1 " ).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 AE from the source sheet to row 2+ in the target sheet
SourceCells.Copy TargetSht.Cells(2, SourceCol)

Sheet115.Select
Range( " AE2:AE21 " ).Select
Range( " AE21 " ).Activate
Selection.ClearContents
Range( " A1 " ).Select


'Advise the user that the process was successful
MsgBox " Data copied successfully! " , vbInformation, " Process Complete "

Exit Sub 'This is to stop the procedure so we dont display the error message every time.
Err_Handler:
MsgBox " The following error occured: " & vbLf & " Error #: " & Err.Number & vbLf & " Description: " & Err.Description, _
vbCritical, " An Error Has Occured " , Err.HelpFile, Err.HelpContext


End Sub


How could I modify it and have it operated for 32 worksheets? I have 32 Teams in a league and the data to be copied is always in the same range on each sheet and pasted to the same location on each sheet.

I also need to convert the data in Range( " AD2:AD21 " ) which is a formula to a Number.

Thnaks for your help here in Canada

Dave 		esigolf (16054)
1148615 2010-10-29 19:17:00 Welcome to PF1 esigolf, it's still quite early in the morning here and its Saturday so I'm sure you will get some answers later on gary67 (56)
1148616 2010-10-29 21:50:00 Thanks, it's Miller time here and I'm going to have a cold one and relax.

Dave

http://www.esigolf.com 		esigolf (16054)
1148617 2010-10-29 22:20:00 I wouldnt post your site here. It maybe classed as spamming Speedy Gonzales (78)
1148618 2010-10-30 00:14:00 Sorry,

How do I delete the link then?

Dave 		esigolf (16054)
1148619 2010-10-30 03:59:00 Send a private message to one of the moderators, unfortunately though you can't send PM's until you have made 10 posts gary67 (56)
1