ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   copy/paste will work seperately, but not in the function i've writ (https://www.excelbanter.com/excel-programming/327330-re-copy-paste-will-work-seperately-but-not-function-ive-writ.html)

JE McGimpsey

copy/paste will work seperately, but not in the function i've writ
 
One way:

I'm not sure what you're doing wrong, but you certainly don't need to do
all those selections. Try something like:

Private Sub CommandButton1_Click()
Dim rCell As Range
Dim rDest As Range
Dim sAnniv As String
With Worksheets("2005")
For Each rCell In .Range("A1:A" & _
.Range("A" & .Rows.Count).End(xlUp).Row)
With rCell
If .Value = "*" Then
sAnniv = .Offset(0, 3 + _
(.Offset(0, 3).Value = "")).Value
Set rDest = Sheets(Format(sAnniv, "mmm")).Range( _
"A" & Rows.Count).End(xlUp).Offset(1, 0)
If rDest.Row < 7 Then _
Set rDest = rDest.Offset(7 - rDest.Row, 0)
.Offset(0, 1).Resize(1, 26).Copy Destination:=rDest
End If
End With
Next rCell
End With
End Sub



In article ,
"DP" wrote:

I've attached my full code, basically, i've got a workbook with a "*" in the
A column if i need the line copied, then there are dates in another column
and the row has to be moved to the tab for the month the date falls in. i
can copy the whole row and paste it not problem, but i would like to copy
everying except the "*" in the A column. i've got code that works
seperately, but it won't work in the sub...can someone please give me some
idea as to what the hell i'm doing wrong???
-------------------------
Private Sub CommandButton1_Click()
Dim monthnum As Integer, counter As Integer, anniversary As Date, subrow
As Variant, sheetname As String
subrow = Array(6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6)
For counter = 1 To 999
If Worksheets("2005").Cells(counter, 1).Value = "*" Then
If Worksheets("2005").Cells(counter, 4).Value = "" Then
anniversary = Worksheets("2005").Cells(counter, 3).Value
Else
anniversary = Worksheets("2005").Cells(counter, 4).Value
End If
monthnum = Month(anniversary)
Select Case monthnum
Case 1
sheetname = "Jan"
subrow(1) = subrow(1) + 1
Case 2
sheetname = "Feb"
subrow(2) = subrow(2) + 1
Case 3
sheetname = "Mar"
subrow(3) = subrow(3) + 1
Case 4
sheetname = "Apr"
subrow(4) = subrow(4) + 1
Case 5
sheetname = "May"
subrow(5) = subrow(5) + 1
Case 6
sheetname = "Jun"
subrow(6) = subrow(6) + 1
Case 7
sheetname = "Jul"
subrow(7) = subrow(7) + 1
Case 8
sheetname = "Aug"
subrow(8) = subrow(8) + 1
Case 9
sheetname = "Sep"
subrow(9) = subrow(9) + 1
Case 10
sheetname = "Oct"
subrow(10) = subrow(10) + 1
Case 11
sheetname = "Nov"
subrow(11) = subrow(11) + 1
Case 12
sheetname = "Dec"
subrow(12) = subrow(12) + 1
End Select

'I'VE TRIED 3 DIFFERENT VERSIONS OF HOW TO DO THIS, NEITHER
WORKS, DON'T KNOW WHY THOUGH...

'#1
Sheets("2005").Select
Range("B7:AA7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("JAN").Select
Range("A7").Select
ActiveSheet.Paste


'#2 THIS IS THE SAME AS #3, EXCEPT WITH NO VARIABLES
'Sheets("2005").Select
'Range(Cells(7, 2), Cells(7, 27)).Select
'Selection.Copy
'Sheets(sheetname).Select
'Worksheets(sheetname).Range(Cells(7, 2), Cells(7, 27)).Select
'ActiveSheet.Paste

'#3 - THIS IS THE SAME AS #2, BUT WITH VARIABLES
'Worksheets("2005").Range(Cells(counter, 2), Cells(counter,
27)).Copy
'Worksheets(sheetname).Select
'Worksheets(sheetname).Range(Cells(columnto, 1),
Cells(columto, 26)).Select
'Worksheets(sheetname).Paste

'THIS ONE WORKS
Worksheets("2005").Rows(counter).Copy
Worksheets(sheetname).Select
Worksheets(sheetname).Rows(subrow(monthnum)).Selec t
Worksheets(sheetname).Paste
ElseIf Worksheets("2005").Cells(counter, 2).Value = "Grand Total" Then
Exit For
End If
Next counter
End Sub



All times are GMT +1. The time now is 11:40 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com