transfer to tab based on a cell

[uk747]

Currently have

ThisWorkbook.Sheets("Sheet1").Range("B8:G8").Copy
    Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

B8 contains a date and on sheet2 i have lots of columns, what i was wondering is If I had lots of Tabs Jan Feb Mar etc would it be possible to transfer the Cells B8:G8 to the tab based on B8

i.e. =if(month(Sheet1!B8)=1, copy B8:G8 and paste in 1st available row on the Jan Tab

or =if(month(Sheet1!B8)=2, copy B8:G8 and paste in 1st available row on the Feb Tab

<COLGROUP><COL style="WIDTH: 60pt" width=80><TBODY>
</TBODY>

 

[pbornemeier]

Try this:

Sub MoveToMonthTab()

    Dim sTabName As String
    Dim lNextWriteRow As Long
    
    sTabName = Format(DateSerial(2000, Range("B8").Value, 1), "MMM")
    With Worksheets(sTabName)
        lNextWriteRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        ThisWorkbook.Sheets("Sheet1").Range("B8:G8").Copy
        .Range("A" & lNextWriteRow).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
End Sub

 

[uk747]

didnt seem to work got runtime error 13 type mismatch then highlighted sTabName = Format(DateSerial(2000, Range("B8").Value, 1), "MMM")

would it make a difference if the details in B8 was a formula being =IF(A3="","",TODAY())

 

[pbornemeier]

The code assumes that B8 contains (or the formula in it returns) a number from 1 to 12.

Use this code since it contains a date:

Sub MoveToMonthTab()

    Dim sTabName As String
    Dim lNextWriteRow As Long
    
    sTabName = Format(Range("B8").Value, "MMM")
    With Worksheets(sTabName)
        lNextWriteRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        ThisWorkbook.Sheets("Sheet1").Range("B8:G8").Copy
        .Range("A" & lNextWriteRow).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
End Sub

 

[uk747]

Run time Error 9 - subscript out of range, then it highlights With Worksheets(sTabName).

I have tried using 4 sheets, Sheet1 where the data is to be copied from then tabs Jan Feb and Mar.

 

[uk747]

sorry did work I entered an inocrrect value. If i needed to transfer to a new book how would the code be amended, i tried the code below but didnt work

Sub MoveToMonthTab()
Dim wbDEST As Workbook
Set wbDEST = Workbooks.Open("C:\MyDocs\Files\Test.xlsx", , , , "password")
Dim sTabName As String
Dim lNextWriteRow As Long
　
sTabName = Format(Range("B8").Value, "MMM")
With Worksheets(sTabName)
lNextWriteRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
ThisWorkbook.Sheets("Sheet1").Range("B8:G8").Copy
wbDEST.Sheets("testresult").Range("A" & lNextWriteRow).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
　
End With
End Sub

 

[pbornemeier]

You no longer need to use a reference to the value in B8 since everything is copied to a single worksheet in the other workbook.

    Dim wbDEST As Workbook
    'Dim sTabName As String
    Dim lNextWriteRow As Long
     
    Set wbDEST = Workbooks.Open("C:\MyDocs\Files\Test.xlsx", , , , "password")
 
    With wbDEST.Worksheets("testresult")
        lNextWriteRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    End With
    
    'sTabName = Format(Range("B8").Value, "MMM")
    'With Worksheets(sTabName)
        ThisWorkbook.Sheets("Sheet1").Range("B8:G8").Copy
        wbDEST.Sheets("testresult").Range("A" & lNextWriteRow).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'End With
    
    wbDEST.Save
    wbDEST.Close
    
    Set wbDEST = Nothing
End Sub

 

[uk747]

Thanks, but I still need it to transfer to individual sheets in the new workbook Test.xls so if B8 was 8 MAr it would transfer to the MAr tab in Text.xls

 

[pbornemeier]

This should do it:

Sub MoveToMonthWksInNewWbk()

    Dim wbDEST As Workbook
    Dim sTabName As String
    Dim lNextWriteRow As Long
     
    sTabName = Format(Range("B8").Value, "MMM") 'Cell contains a date
    
    Set wbDEST = Workbooks.Open("C:\MyDocs\Files\Test.xlsx", , , , "password")
 
    With wbDEST.Worksheets(sTabName)
        lNextWriteRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Range("A" & lNextWriteRow).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
    
    wbDEST.Save
    wbDEST.Close
    
    Set wbDEST = Nothing
End Sub

If you are going to be writing frequently to wbDEST you may want to consider opening it when your source workbook opens and closing it when your source workbook closes. This will prevent it opening and closing multiple times.

 

[uk747]

Run Time Error 1004
It did go to the Jan Tab but didnt enter anything and when /i clicked debug it highlighted

.Range("A" & lNextWriteRow).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False