Copy specific cells of multiple rows in Sheet1 depending on the date in column A and pasting it in specific cells in sheet2

[Pascal_Wyss]

Hello Everyone,

As a standard opening remark i want to say that I am an absolute VBA newcomer and have very little idea of coding. That sad, it is a pretty big task for mi that I have in hand. So I am most grateful of any and all help given!!!

My problem is as follows:

In Sheet1 I have a Table containing Date of the patient visit (Todays Date), patient name, treatment and pricing among other data. So basically, every patient arriving gets a new row.
I need to create a button (macro) that is able to identify the range of patients that visited today and copy specific cells of all the rows containing todays date in sheet1.

For example: From row 221 to row 275 are patients with today’s date, from these patients I need to copy content of column A,B,D,E,H,I and paste the values in sheet2 in the first free row. But the catch is that the columns are not in the same sequence. So content from column A goes in to B and B in to H… etc.

I hope that my description is understandable.

As it would be difficult to attach an example as it is a live workbook containing confidential data.

I thank you all in advanced for your efforts.
With best regards
Pascal

 

[Pascal_Wyss]

If the link still wont work please let me know and i will send per email or any other means.

"prohmex.ch/CENTROS_XPLORA_3D_v1_Madrid_test.xlsm"

 

[Pascal_Wyss]

Dear Fluff,

I think this happens because your browser wants to directly open the file in stead of downloading it.

Let me see if i can do something to solve this.

 

[Pascal_Wyss]

Dear Fluff,

Try this link please....

http://www.prohmex.ch/fluff.html

Hope this works!

With best regards
Pascal

 

[Fluff]

Same result, but have you tried the mod I showed in post#10?

 

[Pascal_Wyss]

Dear Fluff,

yes i have added the .row to the code.
It gives no further error and it copies and pastes some of the fields, but upon paste it inserts the values in 3 different rows and not in the assigned columns.

It is really strange!

Is there a way i can send you the excel file?

With best regards
Pascal

 

[Fluff]

Do you have any merged cells?

You can upload the file to OneDrive, or dropbox, mark the file as shared & post the link here.

 

[Pascal_Wyss]

Dear Fluff,

I have found a way that surprisingly worked out.
I added the active sheet to all entries.

Sub CierreDia()




Sheets("Pacientes y Tratamiento").Select
    
    Application.ScreenUpdating = False
    Dim bottomA As Long
    Dim bottomB As Long
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    bottomB = Sheets("Registro y Hoja de Caja").Range("B" & Rows.Count).End(xlUp).Offset(1).Row
    Dim c As Range
    For Each c In Range("A5:A" & bottomA)
    
        If c = Date Then
            Sheets("Pacientes y Tratamiento").Cells(c.Row, "A").Copy
            Sheets("Registro y Hoja de Caja").Cells(bottomB, "B").PasteSpecial xlPasteValues
            Sheets("Pacientes y Tratamiento").Cells(c.Row, "B").Copy
            Sheets("Registro y Hoja de Caja").Cells(bottomB, "D").PasteSpecial xlPasteValues
            Sheets("Pacientes y Tratamiento").Cells(c.Row, "D").Copy
            Sheets("Registro y Hoja de Caja").Cells(bottomB, "C").PasteSpecial xlPasteValues
            Sheets("Pacientes y Tratamiento").Cells(c.Row, "E").Copy
            Sheets("Registro y Hoja de Caja").Cells(bottomB, "E").PasteSpecial xlPasteValues
            Sheets("Pacientes y Tratamiento").Cells(c.Row, "H").Copy
            Sheets("Registro y Hoja de Caja").Cells(bottomB, "K").PasteSpecial xlPasteValues
            Sheets("Pacientes y Tratamiento").Cells(c.Row, "I").Copy
            Sheets("Registro y Hoja de Caja").Cells(bottomB, "F").PasteSpecial xlPasteValues
        End If
        bottomB = bottomB + 1
    Next c
    Application.ScreenUpdating = True




End Sub

Now it works out!!!

I do not know why yet, but it works.

I thank you so much for your help!!!!

With best regrds
Pascal

 

[Fluff]

Glad its sorted & thanks for the feedback