CODEWITHSUNDEEP
vbaexcel
Jennifer Blandino
Jennifer Blandino

Reputation: 21

code for Duplicating information between excel spreadsheets

I am trying to figure out how to do a macro that will copy data from one sheet titled Master Sheet onto another sheet titled 2015November but only when an 2015November is found in column k on the Master Sheet. If 2015November is found in column K, then I need all data in cells C, H and J (on that row) to be copied onto the Sheet 2015November into corresponding columns A,B, AND C. I have to duplicate this code a few times. so that it corresponds to the month of sales to create a pipeline of estimated sales for the month.

I've been watching Youtube videos and have tried but can't figure it out.

I need it to find the next blank row to insert it into and I need it to not duplicate any data. Any help would be appreciated! I am using Excel 2011

this is code I've been using 

Sub copycolumns()
Dim lastrow As Long, erow as long

Lastrow=sheet1.cells(rows.count,1).end(xlUp).Row

for i=4 to lastrow
Sheet1.Cells(i,1).Copy
erow=sheet2.Cells(Rows.Count,1).end(xlUp).Offset(1,0).Row

sheet1.Paste Destination=Worksheets(“Sheet2”).Cells(erow,1)

sheet1.Cells(i,3).Copy
sheet1.Paste Destination=Worksheets(“Sheet2”).Cells(erow,2)

sheet1.Cells(i,8).Copy
sheet1.Paste Destination=Worksheets(“Sheet2”).Cells(erow,3)

sheet1.Cells(i,10).Copy
sheet1.Paste Destination=Worksheets(“Sheet2”).Cells(erow,4)

Next i

application.CutCopyMode = False
sheet2.columns().Autofit
Range(“A1”).Select

Upvotes: 2

Views: 79

Answers (2)

BruceWayne
BruceWayne

Reputation: 23285

How's this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 11 Then
    Dim masterWS As Worksheet, altWS As Worksheet
    Dim copy1$, copy2$, copy3$
    Dim altLastRow&

    Set masterWS = Sheets("Master Sheet")
    On Error GoTo ErrHandler
    Set altWS = Sheets(Target.Value)
    On Error GoTo 0 ' ### EDIT By Scott Holtzman ###

    copy1 = masterWS.Cells(Target.Row, 3).Valu
    copy2 = masterWS.Cells(Target.Row, 8).Value
    copy3 = masterWS.Cells(Target.Row, 10).Value

    altLastRow = altWS.Cells(altWS.Rows.Count, 1).End(xlUp).Row
    If Not IsEmpty(altWS.Cells(1, 1)) Then altLastRow = altLastRow + 1
    altWS.Cells(altLastRow, 1).Value = copy1
    altWS.Cells(altLastRow, 2).Value = copy2
    altWS.Cells(altLastRow, 3).Value = copy3

ErrHandler:
    Dim addSheet$
    If Err.Number = 9 Then
        addSheet = MsgBox("The " & Target.Value & " sheet doesn't exist, create it?", vbYesNo)
        If addSheet = vbYes Then
            Sheets.Add.Name = Target.Value
            Sheets(Target.Value).Move after:=masterWS
            Set altWS = Sheets(Target.Value)
        Else
            Exit Sub
        End If
        Resume Next

    End If
End If
masterWS.Activate
End Sub

Pretty straightforward. I tested it and it worked okay for me:

"Master Sheet": enter image description here

"2015November" sheet:

enter image description here

Edit: Updated to include an error handler, in case your sheet doesn't exist. (Note: I'm pretty new to Error Handlers, so if someone has a tip/advice, I'd appreciate it!).

Edit2: Updated to be a Worksheet_Change. Place this code in your "Master Sheet" module.

Upvotes: 1

Scott Holtzman
Scott Holtzman

Reputation: 27259

Place this code in the Master Worksheet Module.

I know you said your sheets are there already, but I added some error testing in case you type the name wrong or don't have the sheet after all. The code assumes the sheet names will be equal to the sales dates in column K.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 11 Then ' column K

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(Target.Value2)
    On Error GoTo 0 

    If Not ws Is Nothing Then 

         With ws

             Dim lRow As Long
             lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1

             .Range("A" & lRow).Value = Me.Cells(Target.Row, 3) ' Column C
             .Range("B" & lRow).Value = Me.Cells(Target.Row, 8) ' Column H
             .Range("C" & lRow).Value = Me.Cells(Target.Row, 10) ' Column J

         End With

    Else

         Msgbox "Sheet Does Not Exist! Add sheet and modify cell again!"

    End If

End If

End Sub

Upvotes: 0

Related Questions