Okay, I need help with this. My goal is to use the following code to export any line that matches a managers name into a corosponding spreadsheet for each manager from our master report. I was using the first bit of code on a test file to help me learn how to get it to work but this only goes from one sheet to another in the same workbook, and since I have tried to replicate the same thing but using a bit of code I found to open the external books now it is not copying the lines, just tossing up errors about subscript out of range.
It's probably something simple that I am missing but I am at a loss and I have been trying to figure this out for the better part of an hour with nothing making sense to me.
It's probably something simple that I am missing but I am at a loss and I have been trying to figure this out for the better part of an hour with nothing making sense to me.
Code:
'this works as long as it is in the same workbook.
Sub Button4_Click()
'----------------------------------------------------------------------
'This Copies a row
'----------------------------------------------------------------------
Dim c As Range
Dim lastrow As Long
Dim d As Range
Dim nextRow As Long
Dim nextRow2 As Long
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2")
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 1).Row
nextRow2 = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 1).Row
nextRow = 1
'nextRow2 = 1
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlDown).Row
Application.ScreenUpdating = False
Set c = Range("A1", Range("A9999").End(xlDown))
For Each d In c
'----------------------------------------------------------------------
'This sets the critiera being looked for in each row
'----------------------------------------------------------------------
If d.Value = "Item 1" Then
Range("A" & d.Row & ":AE" & d.Row).Copy Sheets("Sheet2").Range("A" & iRow)
iRow = iRow + 1
ElseIf d.Value = "Item 2" Then
Range("A" & d.Row & ":AE" & d.Row).Copy Sheets("Sheet3").Range("A" & nextRow2)
nextRow2 = nextRow2 + 1
End If
Next d
Application.ScreenUpdating = True
End Sub
Code:
'THis is the code I have so far and it freaks out when it gets to either the sheet name or external sheet name
Sub CopyRow(control As IRibbonControl)
'----------------------------------------------------------------------
'This Copies a row
'----------------------------------------------------------------------
Dim c As Range
Dim lastrow As Long
Dim d As Range
Dim nextRow As Long
Dim nextRow2 As Long
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets(strName)
Dim wbTarget As Workbook 'workbook where the data is to be pasted
Dim wbThis As Workbook 'workbook from where the data is to copied
'Dim strName As String 'name of the source sheet/ target workbook
Dim strNae As String
strName = ActiveSheet.Name
Set wbThis = ActiveWorkbook 'set to the current active workbook (the source book)
strName = ActiveSheet.Name 'get the active sheetname of the book
MsgBox strName
'open a workbook that has same name as the sheet nme
Set wbTarget = Workbooks.Open("C:\Desktop\TestFolder\Test.xlsx") 'this opens the workbook that should be targeted
'-----------------------------------------------------------------------------------------
' This is being skipped, not sure why? Not a big issue yet.
'-----------------------------------------------------------------------------------------
If ActiveSheet.Name = "Schedule" Then
MsgBox "The Schedule may not be Exported, please check the sheet name again."
Else
'-----------------------------------------------------------------------------------------
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 1).Row
nextRow2 = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 1).Row
nextRow = 1
nextRow2 = 1
'lastrow = wbTarget("Ideas").Cells(Rows.Count, "A").End(xlDown).Row
Application.ScreenUpdating = False
Set d = ws.Range("A11", Range("R9999").End(xlDown))
For Each d In c
'----------------------------------------------------------------------
'This sets the critiera being looked for in each row
'----------------------------------------------------------------------
If d.Value = "Manager A" Then
Range("A" & d.Row & ":AE" & d.Row).Copy wbTarget.Sheets("Report").Range("A" & iRow)
iRow = iRow + 12
' ElseIf d.Value = "Manager B" Then
' Range("A" & d.Row & ":AE" & d.Row).Copy Sheets(strNae).Range("A" & nextRow2)
' nextRow2 = nextRow2 + 1
End If
Next d
Application.ScreenUpdating = True
End If
End Sub