VBA to Copy/Paste Range in Sheet Named By Cell Value

[Small Paul]

Hi

I have a worksheet named "Required Data". In column A is a variable range of numbers (1,2,3,etc) and for each number there is a corresponding worksheet (named 1,2,3 etc).

I need to copy the data in columns D:M and paste it in the 1st empty row of the corresponding worksheet e.g if A2 is 1, paste D2:M2 in worksheet 1. I then need to loop until the column is blank.

This is what I have at the moment (thanks to a previous post by 'Fluff'):

Sub Comms_Splitting_Data_2()'
' Comms_Splitting_Data_2 Macro
'
Dim a As Integer
Dim detail As String
Dim Wbk As Workbook


Set Wbk = Workbooks("Commission Statements.xlsm")
With Workbooks("Commission Statements.xlsm").Sheets("Required Data")
   a = 1
   Do Until IsEmpty(.Cells(a, 1))
   Cells(2, 1).Activate
      Range(Cells(0, 3), Cells(0, 13)).Copy
      
      detail = Cells(a, 1).Value
      Wbk.Sheets(detail).Visible = False
      Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
      Sheets("Required Data").Activate
      
      a = a + 1
   Loop
End With
'
End Sub

If this is not possible, I have each of the worksheet names in cell L1 of each sheet. Would it be easier to Find the column A number via that?

Any help would be welcome.

Many thanks
Small Paul.

 

[Small Paul]

Hi
Schoolboy error on my part - apologies.
However, it has pasted across to ws 1 and the first line (of 4) to sheet 12. Nothing else!
Small Paul.

 

[JustynaMK]

Any chance you could share your file, or even a small part of it with some random data?

 

[Small Paul]

I have uploaded the spreadsheet to Dropbox:

https://www.dropbox.com/s/ry6kke3lao5h7dv/Commission Statements Sanitised For Public.xlsm?dl=0

I have also uploaded the VBA code which gets to the mid-point I am now trying to get past:

https://www.dropbox.com/s/l4yirkv0xcmjuj9/Comms Statement Macro Coding.docx?dl=0

 

[JustynaMK]

Thanks - I will take a look at it tonight.

 

[Small Paul]

Thank you so very much. I have been pulling my hair out over this for about a month!

 

[JustynaMK]

Hi, thanks for sharing the file. When I use the latest version of your code (posted below) I already see an issue with this line of code:

Sheets(detail).Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues

For each sheet ("detail") you are identifying the last row of data by using column B and that is where you want to paste your values. However, notice that in some sheets it isn't the right place to paste the data. In your VBA, go to Immediate Window (Ctrl+G), paste the following statement and press enter:

?Sheets("2").Range("B" & Rows.Count).End(xlUp).Offset(1).address

For sheet "2", VBA identified cell B26 as a place to paste data, but this action will overwrite your "Comission Paid" calculation (cells H26:K26). Two loops later it will also stop when copying data into cell B28 (the same sheet), as your cells J28:K28 are merged and VBA cannot paste data into merged cells.

One solution might be to identify the last row by column K, rather than column B:

Sheets(detail).Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues

You can also stick to column "B" identifier, but first you'd need to insert a new row before pasting your values. Let me know your thoughts.

The latest code:

Sub Comms_Splitting_Data_2() '
' Comms_Splitting_Data_2 Macro
    Dim b As Integer
    Dim detail As String
    Dim Wbk As Workbook
    Set Wbk = Workbooks("Commission Statements.xlsm")
    With Workbooks("Commission Statements.xlsm").Sheets("Required Data")
       b = 2
       Do Until IsEmpty(.Cells(b, 1))
          .Range(Cells(b, 4), Cells(b, 13)).Copy
          detail = .Cells(b, 1).Value
          Sheets(detail).Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
          b = b + 1
       Loop
    End With
End Sub

 

[Small Paul]

Hi JustynMK

Thank you for your help. I have been awaiting 'criteria confirmation' before saying. Typically, it has now changed! The 'Required Data' sheet now needs splitting!

The code I am working with is:

Sub Comms_Statements_Splitting_Data_3()'
' Comms_Statements_Splitting_Data_3 Macro
'


Dim b As Integer
Dim detail As String
Dim rng As Range
Set rng = Range("A:A")
Dim Wbk As Workbook
Dim ws As Worksheet
Dim values As Range
Dim v As Long
Dim sheetname As String
Dim active As Worksheet
Set active = activesheet
Dim cell As Integer


With activesheet
'v = Range("A2").Select
v = Range("A2").Activate


If Not IsError(v) Then
Else
End If


With Selection
b = 2
'Do Until first empty cell in comlumn A
Do Until IsEmpty(ActiveCell)
'If A2 = A1 AND B2 = B1
If ActiveCell.Value = ActiveCell.Offset(-1).Value And .Offset(0, 1).Value = .Offset(-1, 1).Value Then
'Copy cells in columns D:M
'wbk("Commission Statements.xlsm").ws("Required Data").rng(cells(b, 4), cells(b, 13)).Copy
Wbk.rng(cells(b, 4), cells(b, 13)).Copy
'Go to Worksheet named in column A
detail = .cells(b, 1).Value
'Paste
Sheets(detail).Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValue


'If A2 = A1 BUT B2 > B1
ElseIf ActiveCell.Value = ActiveCell.Offset(-1).Value And ActiveCell.Offset(0, 1).Value > ActiveCell.Offset(-1, 1).Value Then
'Go to Worksheet named in Column A
detail = .cells(b, 1).Value
'Copy cells B8:K9
ws.Range("B8:K9").Copy
'Go to bottom line of data in column K
'Paste
Range("" & Rows.Count).End(xlUp).Offset(3).PasteSpecial xlPasteValues
'Return to Active Cell in "Required Data" Worksheet
ws("Required Data").Activate
'Copy cells in columns D:M
Range(cells(b, 4), .cells(b, 13)).Copy
'Go to Worksheet named in column A
'Locate last row of data in column K and offset 1 row
detail = .cells(b, 1).Value
'Paste
Sheets(detail).Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues


b = b + 1
End If
Loop
End With
End With
End Sub

Using F8, it runs through to

If ActiveCell.Value = ActiveCell.Offset(-1).Value And .Offset(0, 1).Value = .Offset(-1, 1).Value Then

But then jumps straight to

ElseIf ActiveCell.Value = ActiveCell.Offset(-1).Value And ActiveCell.Offset(0, 1).Value > ActiveCell.Offset(-1, 1).Value Then

Followed by

Loop

It is therefore running a never ending Loop which carries out (copy/paste) action.

Any thoughts

Cheers
Small Paul.

 

[JustynaMK]

Hi!

Three things that can be checked:

1) Your first "If" statement might be incorrect (it didn't work on my side) - I'd suggest adding "ActiveCell" prefix to your code:

If ActiveCell.Value = ActiveCell.Offset(-1).Value And [COLOR=#ff0000]ActiveCell[/COLOR].Offset(0, 1).Value = [COLOR=#ff0000]ActiveCell[/COLOR].Offset(-1, 1).Value Then

2) Your loop does not move through Selection, meaning that it constantly evaluates the same cell (ActiveCell). In order to "jump" to the next cell with each Loop, you need to add the following statement to your code (after "End If" but before "Loop"):

ActiveCell.Offset(1, 0).Select

(personally I do not like working with "Select", but because your "Do Until" evaluates ActiveCell it needs to be selected)

3) Make sure that your Selection ("With Selection") contains a blank cell, so that "Do Until IsEmpty(ActiveCell)" can end at some point.

Hope it works for you.

 

[Small Paul]

Hi (again!)

1) You have inadvertently found my issue. The 'activecell' is in the coding above for the 1st IF statement and that is why I am soo confused!
2) Great point. I have added in the code you suggest. I was thinking (wrongly as always) that the

b = b + 1

would change the ActiveCell (when combined with):

With Selection
b = 2

3) At the bottom of ALL the columns (test sheet has 41 rows) the next row will always be blank.

It still jumps from "THEN" to "ELSEIF" !!

Cheers
Small Paul.

 

[JustynaMK]

Cool! You can now activate Immediate Window (VBA - Ctrl+G) and check why the condition is skipping the first "If...Then" statement:

ActiveCell.Value = ActiveCell.Offset(-1).Value And ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(-1, 1).Value

Select one cell where you would expect the code to work, paste the following statement into Immediate Window and press Enter (notice the question mark at the beginning):

?ActiveCell.Value = ActiveCell.Offset(-1).Value And ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(-1, 1).Value

See if it returns True or False (if False, the code properly moves to "ElseIf" part). You can then start analysing all ingredients and see why it evaluates to False (these are 4 queries so treat them separately):

?ActiveCell.Value

?ActiveCell.Offset(-1).Value

?ActiveCell.Offset(0, 1).Value

?ActiveCell.Offset(-1, 1).Value

Let me know the results.