Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #2  
Old 03-08-2014, 04:34 AM
macropod's Avatar
macropod macropod is offline How to copy data automatically to particular sheet? Windows 7 32bit How to copy data automatically to particular sheet? Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

You could add a macro like the following to your 'main' sheet's code module, but you'll need to fix your spelling before the code will work properly.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRowTgt As Long, lRowDst As Long, i As Long, j As Long
Dim StrDst As String, bFilled As Boolean, bDiff As Boolean, bCol As Boolean
With Target.Worksheet
  ' Find the last row on the input sheet
  lRowTgt = .Range("A" & .Rows.Count).End(xlUp).Row
  ' Check whether we're on the last row
  If Not Intersect(Target, .Range("A" & lRowTgt & ":D" & lRowTgt)) Is Nothing Then
    ' Check whether all cells in columns A:D on the last row are filled in
    bFilled = True
    For i = 1 To 4
      If .Cells(lRowTgt, i).Value = "" Then
        bFilled = False
      End If
    Next
    If bFilled = True Then
    ' All cells in columns A:D on the last row are filled in
      With Target.Worksheet
        ' Find the output sheet
        StrDst = "Customer " & UCase(Trim(.Cells(lRowTgt, 1).Value))
        ' Find the last row on the output sheet
        With Sheets(StrDst)
          lRowDst = .Range("A" & .Rows.Count).End(xlUp).Row
        End With
        ' See if we can find a row on the output sheet that has the same values as the input sheet
        For i = 2 To lRowDst
          bDiff = True
          If .Cells(lRowTgt, 2).Value = Sheets(StrDst).Cells(i, 1).Value And _
            .Cells(lRowTgt, 3).Value = Sheets(StrDst).Cells(i, 2).Value And _
            .Cells(lRowTgt, 4).Value = Sheets(StrDst).Cells(i, 3).Value Then
            bDiff = False: Exit For
          End If
        Next
        If bDiff = True Then
          ' No matches, so copy from the input sheet to the output sheet
          lRowDst = lRowDst + 1
          .Range("B" & lRowTgt & ":D" & lRowTgt).Copy
          With Sheets(StrDst)
            .Paste Destination:=.Range("A" & lRowDst)
          End With
        End If
      End With
    End If
  End If
  ' Find the last row on the input sheet
  lRowTgt = .Range("F" & .Rows.Count).End(xlUp).Row
  ' Check whether we're on the last row
  If Not Intersect(Target, .Range("F" & lRowTgt & ":I" & lRowTgt)) Is Nothing Then
    ' Check whether all cells in columns F:I on the last row are filled in
    bFilled = True
    For i = 6 To 9
      If .Cells(lRowTgt, i).Value = "" Then
        bFilled = False
      End If
    Next
    If bFilled = True Then
    ' All cells in columns F:I on the last row are filled in
      With Target.Worksheet
        ' Find the output sheet
        StrDst = "Customer " & UCase(Trim(.Cells(lRowTgt, 6).Value))
        ' Find the last row on the output sheet
        With Sheets(StrDst)
          lRowDst = .Range("F" & .Rows.Count).End(xlUp).Row
        End With
        ' See if we can find a row on the output sheet that has the same values as the input sheet
        For i = 2 To lRowDst
          bDiff = True
          If .Cells(lRowTgt, 7).Value = Sheets(StrDst).Cells(i, 5).Value And _
            .Cells(lRowTgt, 8).Value = Sheets(StrDst).Cells(i, 6).Value And _
            .Cells(lRowTgt, 9).Value = Sheets(StrDst).Cells(i, 7).Value Then
            bDiff = False: Exit For
          End If
        Next
        If bDiff = True Then
          ' No matches, so copy from the input sheet to the output sheet
          lRowDst = lRowDst + 1
          .Range("G" & lRowTgt & ":I" & lRowTgt).Copy
          With Sheets(StrDst)
            .Paste Destination:=.Range("E" & lRowDst)
          End With
        End If
      End With
    End If
  End If
End With
Application.CutCopyMode = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
How to Copy data from Outlook mail and Paste it in a Excel sheet? padhu1989 Outlook 0 09-11-2012 04:07 AM
sheet 2 data highlight in sheet 1 gsrikanth Excel 1 04-21-2012 06:25 PM
How to copy data automatically to particular sheet? How to copy automatically data from Excel file to Word file? fuchsd Word 6 10-25-2011 05:52 AM
If two geographical data match in two sheets, copy unique id/code found in one sheet alliage Excel 1 09-01-2011 05:23 AM
copy cell from sheet 2 to sheet 3 macro slipperyjim Excel Programming 1 02-18-2010 01:31 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 11:33 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft