not pasting

M

MS2018

New Member
Joined
Feb 6, 2018
Messages
11
Hi Guys

Can someone please urgently help. Why this code isnt pasting in another workbook.

it doesnt show any error, but doesnt post either. (pasting code is the fourth line from bottom). Thanks so much

Sub SplitData()
Const NameCol = "c"
Const HeaderRow = 1
Const HeaderRow2 = 2
Const HeaderRow3 = 3
Const FirstRow = 4
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim Centrebook As String

Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Centre As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Centre = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Centre)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Centre

SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)

Workbooks.Add

ActiveWorkbook.SaveAs Filename:="L:\EEO Department" & Centre & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


Centrebook = ActiveWorkbook.Name


End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Windows("2018 Enrolment Status (Auto).xlsm").Activate
Sheets(Centre).Select
Cells.Select
Selection.Copy
' Windows("L:\EEO Department" & Centrebook).Activate
Workbooks.Open ("L:\EEO Department" & Centrebook)
Range("A1").Select
ActiveSheet.Paste

Next SrcRow
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
Try changing this
Code: 
Workbooks.Open ("L:\EEO Department" & Centrebook)
        Range("A1").Select
ActiveSheet.Paste
to
Code: 
Workbooks(Centrebook).Sheets(1).Range("A1").PasteSpecial
 
Upvote 0
Hi MS2018 and Welcome to the Board! U can trial this. It's unclear what you're trying to achieve? Please use code tags. HTH. Dave
Code: 
Sub SplitData()
 Const NameCol = "c"
 Const HeaderRow = 1
 Const HeaderRow2 = 2
 Const HeaderRow3 = 3
 Const FirstRow = 4
 Dim SrcSheet As Worksheet
 Dim TrgSheet As Worksheet
 Dim Centrebook As String

 Dim SrcRow As Long
 Dim LastRow As Long
 Dim TrgRow As Long
 Dim Centre As String
 Application.ScreenUpdating = False
 Set SrcSheet = ActiveSheet
 LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
 For SrcRow = FirstRow To LastRow
 Centre = SrcSheet.Cells(SrcRow, NameCol).Value
 Set TrgSheet = Nothing
 On Error Resume Next
 Set TrgSheet = Worksheets(Centre)
 On Error GoTo 0
 If TrgSheet Is Nothing Then
 Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
 TrgSheet.Name = "Centre"
 SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
 Workbooks.Add
ActiveWorkbook.SaveAs Filename:="L:\EEO Department" & Centre & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 Centrebook = ActiveWorkbook.Name
 End If
 TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
 SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
 Windows("2018 Enrolment Status (Auto).xlsm").Activate
 Sheets(Centre).Cells.Copy
 ' Windows("L:\EEO Department" & Centrebook).Activate
 Workbooks.Open ("L:\EEO Department" & Centrebook)
 Sheets("sheet1").Range("A1").Paste
 Next SrcRow
 Application.ScreenUpdating = True
 End Sub
 
Upvote 0
HI Dave

Thanks for your reply

My code is working now, I changed Activesheet.paste to Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

What I am trying to do is

1. I have a master file with data for all centres

[TABLE="width: 690"]
<tbody>[TR]
[TD]WeekBeg
[/TD]
[TD]ManGroupName
[/TD]
[TD]Centre
[/TD]
[TD]CentreCode
[/TD]
[TD] Mon_C
[/TD]
[TD] Tue_C
[/TD]
[TD] Wed_C
[/TD]
[TD] Thu_C
[/TD]
[TD] Fri_C
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]Chris
[/TD]
[TD]4710
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]Chris
[/TD]
[TD]4710
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]Dave
[/TD]
[TD]4710
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 2
[/TD]
[TD] 2
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]Dave
[/TD]
[TD]4720
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]MS
[/TD]
[TD]4720
[/TD]
[TD] 1
[/TD]
[TD] 2
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]MS
[/TD]
[TD]4720
[/TD]
[TD] 1
[/TD]
[TD] 3
[/TD]
[TD] 2
[/TD]
[TD] 2
[/TD]
[TD] 1
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]MS
[/TD]
[TD]4725
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[/TR]
</tbody>[/TABLE]

2. I have to divide the data and paste them
one- in separate sheets in the same workbook with the sheet name being the centre name, i.e sheet name Chris with only Chris's data (first 2 rows from above data) and so on everyone else

Two- in a separate workbook i.e. create a separate file for each centre. But in this one I also need to hide a lot of coloumns. i.e Create a new excel file name Chris with the 2 lines belonging to Chris, but in that I only need to show Col C (Centre) and last five Days columns. Save file at a particular location and close it.

3. Later on I also have to think how to set up the print options for these individual files as my customer base is old age people so I have to give them an option of just clicking print and it prints in A3 landscape. but that's another battle

Thanks

Here is the code

Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Centre As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Centre = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Centre)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Centre

SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
SrcSheet.Rows(HeaderRow2).Copy Destination:=TrgSheet.Rows(HeaderRow2)
SrcSheet.Rows(HeaderRow3).Copy Destination:=TrgSheet.Rows(HeaderRow3)
SrcSheet.Rows(HeaderRow4).Copy Destination:=TrgSheet.Rows(HeaderRow4)

Workbooks.Add
ActiveWorkbook.SaveAs Filename:="L:\EEO Department" & Centre & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Centrebook = ActiveWorkbook.Name

End If
' Paste in centre sheet
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
' Paste in centre Workbook
Windows("2018 Enrolment Status (Auto).xlsm").Activate
Sheets(Centre).Select
Cells.Select
Cells.EntireColumn.AutoFit
Selection.Copy
'Windows("L:\EEO Department" & Centrebook).Activate
Workbooks.Open ("L:\EEO Department" & Centrebook)
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'Formatting Centre workbook
Cells.Select
With Selection
.WrapText = True
.WrapText = False
End With
Cells.EntireColumn.AutoFit

' Columns("A:B").Select
' Application.CutCopyMode = False
' Selection.EntireColumn.Hidden = True
ActiveWorkbook.Save
ActiveWorkbook.Close

Next SrcRow
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks a lot your reply

My code is working now, I changed Activesheet.paste to Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

What I am trying to do is

1. I have a master file with data for all centres

[TABLE="width: 690"]
<tbody>[TR]
[TD]WeekBeg
[/TD]
[TD]ManGroupName
[/TD]
[TD]Centre
[/TD]
[TD]CentreCode
[/TD]
[TD]Mon_C
[/TD]
[TD]Tue_C
[/TD]
[TD]Wed_C
[/TD]
[TD]Thu_C
[/TD]
[TD]Fri_C
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]Chris
[/TD]
[TD]4710
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]Chris
[/TD]
[TD]4710
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]Dave
[/TD]
[TD]4710
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 2
[/TD]
[TD] 2
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]Dave
[/TD]
[TD]4720
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]MS
[/TD]
[TD]4720
[/TD]
[TD] 1
[/TD]
[TD] 2
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]MS
[/TD]
[TD]4720
[/TD]
[TD] 1
[/TD]
[TD] 3
[/TD]
[TD] 2
[/TD]
[TD]2
[/TD]
[TD] 1
[/TD]
[/TR]
[TR]
[TD]29/01/2018
[/TD]
[TD]Primary
[/TD]
[TD]MS
[/TD]
[TD]4725
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[TD] -
[/TD]
[TD] 1
[/TD]
[TD] 1
[/TD]
[/TR]
</tbody>[/TABLE]

2. I have to divide the data and paste them
one- in separate sheets in the same workbook with the sheet name being the centre name, i.e sheet name Chris with only Chris's data (first 2 rows from above data) and so on everyone else

Two- in a separate workbook i.e. create a separate file for each centre. But in this one I also need to hide a lot of coloumns. i.e Create a new excel file name Chris with the 2 lines belonging to Chris, but in that I only need to show Col C (Centre) and last five Days columns. Save file at a particular location and close it.

3. Later on I also have to think how to set up the print options for these individual files as my customer base is old age people so I have to give them an option of just clicking print and it prints in A3 landscape. but that's another battle

Thanks

Here is the code

Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Centre As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Centre = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Centre)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Centre

SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
SrcSheet.Rows(HeaderRow2).Copy Destination:=TrgSheet.Rows(HeaderRow2)
SrcSheet.Rows(HeaderRow3).Copy Destination:=TrgSheet.Rows(HeaderRow3)
SrcSheet.Rows(HeaderRow4).Copy Destination:=TrgSheet.Rows(HeaderRow4)

Workbooks.Add
ActiveWorkbook.SaveAs Filename:="L:\EEO Department" & Centre & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Centrebook = ActiveWorkbook.Name

End If
' Paste in centre sheet
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
' Paste in centre Workbook
Windows("2018 Enrolment Status (Auto).xlsm").Activate
Sheets(Centre).Select
Cells.Select
Cells.EntireColumn.AutoFit
Selection.Copy
'Windows("L:\EEO Department" & Centrebook).Activate
Workbooks.Open ("L:\EEO Department" & Centrebook)
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'Formatting Centre workbook
Cells.Select
With Selection
.WrapText = True
.WrapText = False
End With
Cells.EntireColumn.AutoFit

' Columns("A:B").Select
' Application.CutCopyMode = False
' Selection.EntireColumn.Hidden = True
ActiveWorkbook.Save
ActiveWorkbook.Close

Next SrcRow
Application.ScreenUpdating = True
End Sub
 
Upvote 0
however I am thinking of making two macros now

one for creating separate centre tabs in the all data workbook

second macro for saving individual files , setting their print settings and sending them via email
 
Upvote 0
Glad U got your initial request resolved. It's likely better to start a new thread if you have further specific questions on a different topic. However, I think this code will get U started. It will transfer sheet "Master" row data based on "C" names to either a new sheet or to an existing sheet. HTH. Dave
Code: 
Sub TestSheet()
Dim LastRow As Double, LastRow2 As Double, LastCol As Double, Sht As Worksheet, Cnt As Double
'transfer data to wb sheet
With Sheets("Master")
LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
LastCol = .Cells(2, Columns.Count).End(xlToLeft).Column
End With
'loop through names in "C"
For Cnt = 2 To LastRow
For Each Sht In ThisWorkbook.Sheets
If UCase(Sht.Name) = UCase(Sheets("Master").Cells(Cnt, "C")) Then
Sht.Select
With Sheets(Sht.Name)
LastRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
End With
Sheets("Master").Range(Sheets("Master").Cells(Cnt, "A"), Sheets("Master").Cells(Cnt, LastCol)).copy _
Destination:=ThisWorkbook.Sheets(Sht.Name).Range("A" & LastRow2 + 1)
GoTo below
End If
Next Sht
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = CStr(Sheets("Master").Cells(Cnt, "C").Value)
End With
Sheets("Master").Range(Sheets("Master").Cells(Cnt, "A"), Sheets("Master").Cells(Cnt, LastCol)).copy _
Destination:=ThisWorkbook.Sheets(Sheets("Master").Cells(Cnt, "C").Value).Range("A1")
below:
Next Cnt
End Sub
ps. please use code tags
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Auto spliting Macro script
Replies
8
Views
738
My Aswer Is This
My Aswer Is This
V
  • Question Question
clear sheet when new value found in range
Replies
2
Views
382
tonyyy
tonyyy
L
  • Question Question
Any idea how to modify this macro to copy only unique data into all worksheets?
2
Replies
10
Views
1K
JLGWhiz
JLGWhiz
L
  • Question Question
How to add another criteria to this macro, and copy a range of cells instead the entire row.
Replies
6
Views
619
Lehoi
L
B
  • Question Question
Combining two macros in to one VBA code for an Active X button
Replies
2
Views
2K
bull city bob
B

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top