Copy columns from sheet Sales to SavedData

[adam]

Hi Anyone,

I’m having three columns in my workbook where my data starts from the 8th row of the sheet named “Sales”.

I have written a macro code where I’m trying to copy data from the columns A, B, C, & D of the worksheet “Sales” to the columns G, H, I & J of the sheet “SavedData”.

In the Sheet “SavedData” I want the copied columns to start from the first empty row each time I copy them from the sheet “Sales”.

In the column A I have the text “Product name” which I don’t want to get copied into column "H" also in column "B" I have the text “result” which I don’t want to get copied into the Column “H”. And in column C I have “Units” which I don’t want to get copied into column “I” And in column “D”, I have the text “reference” which I don’t want to get copied into the column "J" of the worksheet “SavedData”

The code I have written only copies the data in the column D of the worksheet "sales" to the three columns G,H,I & J of the sheet "savedData". and it does not stop copying the text I have mentioned above.

Any help to point out what I have done wrong in my coding would be kindly appreciated.

Thanks in advance.

Code: Select all

Sub CopyDataToSavedData()
    Sheets("Sales").Select
     Range("A8:A100").Select
     Range("B8:B100").Select
     Range("C8:C100").Select
     Range("D8:D100").Select
    Selection.Copy
    Sheets("SavedData").Select
    ActiveSheet.[G65536].End(xlUp)(2).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Selection.Copy
    Sheets("SavedData").Select
    ActiveSheet.[H65536].End(xlUp)(2).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Selection.Copy
    Sheets("SavedData").Select
    ActiveSheet.[H65536].End(xlUp)(2).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Selection.Copy
    Sheets("SavedData").Select
    ActiveSheet.[ID65536].End(xlUp)(2).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Selection.Copy
    Sheets("SavedData").Select
    ActiveSheet.[J65536].End(xlUp)(2).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
End Sub

[HansV]

It isn't necessary to select cells in order to copy them.
Assuming that the product name will always be filled in, you can use:

Code: Select all

Sub CopyDataToSavedData()
  Dim m As Long
  Dim rng As Range

  ' Determine the cell below the last used cell
  ' in column G on the SavedData sheet
  With Worksheets("SavedData")
    Set rng = .Cells(.Rows.Count, 7).End(xlUp).Offset(1, 0)
  End With

  With Worksheets("Sales")
    ' Determine last used row in column A
    ' on the Sales sheet
    m = .Cells(.Rows.Count, 1).End(xlUp).Row
    ' Copy starting at row 9
    .Range("A9:D" & m).Copy
    ' Paste special, values only
    rng.PasteSpecial Paste:=xlPasteValues
  End With
End Sub

[adam]

Hans, Thanks for the code. Your code works excellent. But In my case I have column headers repeated which I don't want them to appear in the copied columns of the woksheet "SavedData".

For example if the save button is clicked the data that is copied from the column A of the worksheet "Sales" I don't want the product name to appear has product name gets doubled. For this reason I want the text that I have mention in this thread to be omitted when the column is copied.

When the columns are copied; the bar below the excel application asks me to press enter to paste the data that has been selected or copied. How could this be prevented instead the columns from sheet "sales" to get copied onto "saved data".

Moreover if I want the cell B2 from the sales to be copied as a string to the sheet "SavedData" How may I modify the following code and add to the code you have provided.

I have attached the workbook for your reference.

Code: Select all

Sub Copydata()


  Dim r As Long
  Dim m As Long
  Dim n As Long
 
  Dim SalesWks As Worksheet
  Dim SavedDataWks As Worksheet

  Dim nextRow As Long
  Dim oCol As Long

  Dim myRng As Range
  Dim myCopy As String
  Dim myCell As Range

  'cells to copy from Sales sheet - some contain formulas
  myCopy = "B2"

  Set NewMemoWks = Worksheets("Sales")
  Set MemosWks = Worksheets("SavedData")
  
    With SalesWks
    Set myRng = .Range(myCopy)
  
      If Application.CountA(myRng) <> myRng.Cells.Count Then
      MsgBox "Please fill in all the fields!"
      Exit Sub
    End If
  End With

[HansV]

You could delete the lines containing Product Name.
You should be able to work out how to copy B2 yourself.

[adam]

Thanks for the reply Hans. I'll try to workout as guided.

[adam]

Can the following code be modified so that the data when copied from the sheet "Orders" to "Database" is as in the attached document's sheet "Database"

Code: Select all

Sub Data()
  Dim m As Long
  Dim rng As Range

  ' Determine the cell below the last used cell
  ' in column G on the Database sheet
  With Worksheets("Database")
    Set rng = .Cells(.Rows.Count, 7).End(xlUp).Offset(1, 0)
  End With

  With Worksheets("Orders")
    ' Determine last used row in column A
    ' on the Orders sheet
    m = .Cells(.Rows.Count, 1).End(xlUp).Row
    ' Copy starting at row 8
    .Range("A8:D" & m).Copy
    ' Paste special, values only
    rng.PasteSpecial Paste:=xlPasteValues
  End With
End Sub

Thanks in advance

[HansV]

Try

Code: Select all

Sub CopyData()
  Dim r As Long
  Dim m As Long
  Dim t As Long
  Dim strCategory As String
  Dim wshSource As Worksheet
  Dim wshTarget As Worksheet
  Set wshSource = Worksheets("Orders")
  Set wshTarget = Worksheets("Database")

  ' Determine the last used row
  ' in column F on the Database sheet
  With wshTarget
    t = .Cells(.Rows.Count, 6).End(xlUp).Row
  End With

  With wshSource
    ' Determine last used row in column A
    ' on the Orders sheet
    m = .Cells(.Rows.Count, 1).End(xlUp).Row
    For r = 6 To m
      If .Cells(r, 1) = "" Then
        If .Cells(r, 2) <> "" Then
          strCategory = .Cells(r, 2)
        End If
      ElseIf .Cells(r, 1) <> "Product Colours" Then
        t = t + 1
        wshTarget.Cells(t, 6) = strCategory
        .Range(.Cells(r, 1), .Cells(r, 4)).Copy
        wshTarget.Cells(t, 7).PasteSpecial Paste:=xlPasteValues
      End If
    Next r
  End With
End Sub

[HansV]

By the way, please note that you're using both the British spelling "colour" and the US spelling "color" on the Orders sheet.

[adam]

Thanks for the code Hans. It's like a dream come true. I'm sorry for using "colours" instead of "colors. Actually my intention is using "colors".

[adam]

As mentioned before the code you had provided works marvelously. But after changing the format of my worksheet I couldnt make it work. I tried for hours to modify the the code according to the ranges in my worksheet. But failed to do so. I'm sorry.

I would be happy if you could assist me further with the format I have attached. Meaning to change the code to suite the columns & rows to the sheet I have attached.

Thanks in advance

[HansV]

That's the problem with your setup. With each change in layout, you need to modify the code. I've told you before that you should create your application in a database program such as Access.

[adam]

Thanks Hans. I got the problem adjusted. Just had to do minor changes.

[adam]

I’m trying to incorporate the following code

Code: Select all

Sub ToPat()
On Error Resume Next
Application.ScreenUpdating = False

  Dim r As Long
  Dim m As Long
  Dim n As Long
 
  Dim PatDetailsWks As Worksheet
  Dim OrdersWks As Worksheet
  Dim DatabaseWks As Worksheet

  Dim nextRow As Long
  Dim oCol As Long

  Dim myRng As Range
  Dim myCopy As String
  Dim myCell As Range

  'cells to copy from Orders sheet - some contain formulas
  myCopy = "B9,F9,F10,F11,F12,F13,F14,H9,H10,H11,H12,H13,H14"

  Set OrdersWks = Worksheets("Orders")
  Set PatDetailsWks = Worksheets("PatDetails")
  Set DatabaseWks = Worksheets("Database")
  
    With OrdersWks
    Set myRng = .Range(myCopy)
  
      If Application.CountA(myRng) <> myRng.Cells.Count Then
      MsgBox "Please fill in all the fields!"
      Exit Sub
    End If
  End With

  m = OrdersWks.Range("H" & OrdersWks.Rows.Count).End(xlUp).Row
  ' Headers are now in row 9
  If m = 15 Then
    MsgBox "No data", vbExclamation
    Exit Sub
  End If

  r = DatabaseWks.Range("C" & DatabaseWks.Rows.Count).End(xlUp).Row + 1
  ' Copy Accession No
  OrdersWks.Range("C" & r & ":E" & (r + m - 16)) = OrdersWks.Range("H9")
  ' Copy Date
  OrdersWks.Range("H12").Copy Destination:=DatabaseWks.Range("B" & r & ":B")
    ' Copy Customer ID
  OrdersWks.Range("B9").Copy Destination:=DatabaseWks.Range("C" & r & ":C")
    ' Copy Accession No
  OrdersWks.Range("H9").Copy Destination:=DatabaseWks.Range("E" & r & ":E")
    ' Copy CL
  OrdersWks.Range("F9").Copy Destination:=DatabaseWks.Range("D" & r & ":D")


  DatabaseWks.Range("A10:M10").Copy
  DatabaseWks.Range("A" & r & ":M" & (r + m - 16)).PasteSpecial Paste:=xlPasteFormats
  Application.CutCopyMode = False

  With PatDetailsWks
    nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End With

  With PatDetailsWks
    With .Cells(nextRow, "A")
      .Value = Now
      .NumberFormat = "hh:mm:ss"
    End With
    oCol = 2
    For Each myCell In myRng.Cells
      PatDetailsWks.Cells(nextRow, oCol).Value = myCell.Value
      oCol = oCol + 1
    Next myCell
  End With

  With OrdersWks.Range("H9")
    .Value = .Value + 1
  End With

  OrdersWks.Range("H9").ClearContents
  'clear input cells that contain constants
  With OrdersWks
  On Error Resume Next
    With .Range("H9").Cells.SpecialCells(xlCellTypeConstants)
     .ClearContents
      Application.GoTo .Cells(1) ', Scroll:=True
    End With
    On Error GoTo 0
  End With
   Application.ScreenUpdating = True
End Sub

Into

Code: Select all

Sub CopyData()
     Application.ScreenUpdating = False
      Dim r As Long
      Dim m As Long
      Dim t As Long
      Dim strCategory As String
      Dim wshSource As Worksheet
      Dim wshTarget As Worksheet
      Set wshSource = Worksheets("Orders")
      Set wshTarget = Worksheets("Database")
      
      

      ' Determine the last used row
      ' in column F on the Database sheet
      With wshTarget
        t = .Cells(.Rows.Count, 6).End(xlUp).Row
      End With

      With wshSource
        ' Determine last used row in column A
        ' on the Orders sheet
        m = .Cells(.Rows.Count, 1).End(xlUp).Row
        For r = 16 To m
          If .Cells(r, 1) = "" Then
            If .Cells(r, 2) <> "" Then
              strCategory = .Cells(r, 2)
            End If
          ElseIf .Cells(r, 1) <> "Product Colours" Then
            t = t + 1
            wshTarget.Cells(t, 6) = strCategory
            .Range(.Cells(r, 1), .Cells(r, 4)).Copy
            wshTarget.Cells(t, 7).PasteSpecial Paste:=xlPasteValues
          End If
        Next r
      End With
            ThisWorkbook.Save
      Application.ScreenUpdating = True
    End Sub

So that when the macro button is clicked
The sheets “Database & “PatDetails” and are filled as shown in the attached document.
But I guess during the combination of the two codes I might have missed out a line which is not making the code to work.

I would be happy if you could help me further in this.

Any help would be kindly appreciated

[HansV]

Which button on which sheet do you want to use? I see four buttons, two on Orders (9) and two on Orders.

[adam]

Sorry Hans, I uploaded the wrong document.

Here's the correct document in which I had reference before. In the new version you'll see three sheets. I want the macro button to be on the sheet "Orders". and when the macro button is clicked I want the data to be saved to the sheets "database" & "PatDetails" as shown in the two sheets.

I hope I have made my question clear.

[HansV]

You could copy the ToPat macro into the same module as CopyData (for example below it), and call ToPat near the end of the CopyData macro:

Code: Select all

Sub CopyData()
  ...
  ThisWorkbook.Save
  Application.ScreenUpdating = True
  Call ToPat
End Sub

Sub ToPat()
  ...

[adam]

I have done as said, but the code does not seem to work to the sample shown in the workbook. The Macro Sub CopyData() does as defined in the code. But the Macro Sub ToPat() does not.

I would be happy if you could assist further.

[HansV]

It does work for me... Could you post the version of the workbook with the modified macro that doesn't work?

[adam]

I have attached the version of my workbook for your reference; which does not work as the way I had requested.

You can see when the macro button in the sheet "Orders" is clicked, the data gets copied into the sheet "Database"but not in the way as I had shown in the previously uploaded document Book1-1-1.

I have added a text box in the sheet "Database to explain what is happening when the macro button is clicked and how I'm requesting the sheet "Database" to be after the macro button is clicked.

I hope I have made my question clear.

[HansV]

The first part of the macro fills columns F:J of the Database sheet correctly. It doesn't fill columns A:E because you haven't written code to fill columns A:E.

The second part of the macro (ToPat) adds one row to the PatDetails sheet, but the data appear to be shifted. So you'll have to edit the code so that it fills the correct cells. You already have the basic code, it is up to you to modify it. You can't expect us to do that for you.