Macro to copy Info

[John_Gil]

Morning Excel Masters :D

I need your help for a simple macro to copy info from one file and paste it with a different format in a final file.

Final file should have the below aspect:

Product	FactType	Unit	Date	Value	Market
RTO021	RollingForecast	P	07/06/2020	28000	DEFAULT
RTO022	RollingForecast	P	07/06/2020	2000	DEFAULT
RTO137	RollingForecast	P	07/06/2020	7000	DEFAULT
RTO051	RollingForecast	P	07/06/2020	0	DEFAULT
RTO053	RollingForecast	P	07/06/2020	475	DEFAULT
RTO026	RollingForecast	P	07/06/2020	0	DEFAULT
RTO028	RollingForecast	P	07/06/2020	1800	DEFAULT
RTO002	RollingForecast	P	07/06/2020	0	DEFAULT
RTO057	RollingForecast	P	07/06/2020	2200	DEFAULT
RTO058	RollingForecast	P	07/06/2020	2500	DEFAULT
RTO059	RollingForecast	P	07/06/2020	0	DEFAULT
RTO060	RollingForecast	P	07/06/2020	2000	DEFAULT
RTO052	RollingForecast	P	07/06/2020	0	DEFAULT

Now as you can see 3 from the 6 columns have always the same value - columns B, C and F. The other 3 columns come from the below file:

So Column A from the final file should come from the Column D.
Column E shoul come from column O.
Finally Column D should come from the merged cells from G1-N1. -On final file the date is always the same.

Thank you guys,
John

 

[DanteAmor]

Try this. Your data on Sheet1, results on Sheet2

Sub CopyInfo()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, fec As String
  
  With Sheets("Sheet1")
    fec = Right(.Range("G1"), 10)
    a = .Range("D5:O" & .Range("D" & Rows.Count).End(3).Row).Value2
  End With
  ReDim b(1 To UBound(a), 1 To 6)
  For i = 1 To UBound(a, 1)
    If a(i, 1) <> "" Then
      j = j + 1
      b(j, 1) = a(i, 1)
      b(j, 2) = "RollingForecast"
      b(j, 3) = "P"
      b(j, 4) = fec
      b(j, 5) = a(i, 12)
      b(j, 6) = "DEFAULT"
    End If
  Next
  Sheets("Sheet2").Range("A2").Resize(UBound(b), 6).Value = b
End Sub

 

[John_Gil]

@DanteAmor Thanks a lot for your help mate!

The macro is working but I have two small issue:
1- The date is copied as dd/mm/yyyy and is pasted in the final file as mm/dd/yyyy;
2- In column A some of the values are not suitable. Please see below in bolt:

Burgers & Meatballs

RTO137

RTO140

RTO141

RTO142

RTE015

RTE016

RTO089

RTO087

Joints

RTO026

RTO051

I think this could be solved with a filter?

Thanks a mill,
Cristian

 

[DanteAmor]

1- The date is copied as dd/mm/yyyy and is pasted in the final file as mm/dd/yyyy;

Change this line:
b(j, 4) = fec

For this:
b(j, 4) = CDate(fec)

2- In column A some of the values are not suitable. Please see below in bolt:
Joints

Does the data "Joints" exist in sheet1?
How do I identify which data to copy and which data not to copy?

 

[John_Gil]

@DanteAmor Date issue is fixed now!!

Yes "Joints" and other meat categories are on sheet 1 as well. Basically the macro should pick up from that line only cells that start wit "RT" since all the codes start with these two letters.

Thanks again for the support!

 

[DanteAmor]

macro should pick up from that line only cells that start wit "RT"

Try this

Sub CopyInfo()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, fec As String
  
  With Sheets("Sheet1")
    fec = Right(.Range("G1"), 10)
    a = .Range("D5:O" & .Range("D" & Rows.Count).End(3).Row).Value2
  End With
  ReDim b(1 To UBound(a), 1 To 6)
  For i = 1 To UBound(a, 1)
    If a(i, 1) <> "" And UCase(Left(a(i, 1), 2)) = "RT" Then
      j = j + 1
      b(j, 1) = a(i, 1)
      b(j, 2) = "RollingForecast"
      b(j, 3) = "P"
      b(j, 4) = CDate(fec)
      b(j, 5) = a(i, 12)
      b(j, 6) = "DEFAULT"
    End If
  Next
  Sheets("Sheet2").Range("A2").Resize(UBound(b), 6).Value = b
End Sub

 

[John_Gil]

Hello @DanteAmor ! How are you?

Sorry for coming back to you but you really helped me a lot the previous time and I have a similar macro to develop and I thing you can help me!


I need to develop a VBA code that brings information from a different file (3 different tabs - file is called Combined Amendments.xlsm) and combines everything into one final file (Customer amends.xlsm).

The final file looks like the table below. We have 7 columns (column 3, 4 and 7 have always the same value): CustomerAmendments.csv

The file from where the information is coming has the previous view (it has more tabs but I just put the 3 ones that matter): Combined amendments.xlsm

Steps of the macro:

1- Filter in tabs "NI" and "ROI" column R by "C" and copy the information from columns C, D, I and P;

2- Filter in tab "OCADO" column Q by "C" and copy the information from columns C, D, I and O;

3- Paste information on the final file according by column order shown in the final file.

I developed the below code but it's not running at ll. I tried to learn it based on the previous code you developed for me.

Sub CustomerAmends()
Dim sh As Worksheet, ary As Variant, i As Long
Set sh = Workbooks("X:\Planning\production plans\production plans\Order Amendments\Combined amendments.xlsm").Sheets(1) 

ary = Array("NI", "ROI", "OCADO")
    For i = LBound(ary) To UBound(ary)
        With Sheets(ary(i))
            .UsedRange.AutoFilter 17, "C"
            .Range("C2", .Cells(Rows.Count, 3).End(xlUp)).Copy sh.Cells(Rows.Count, 5).End(xlUp)(2)
            .Range("D2", .Cells(Rows.Count, 4).End(xlUp)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            .Range("I2", .Cells(Rows.Count, 9).End(xlUp)).Copy sh.Cells(Rows.Count, 6).End(xlUp)(2)
                If i <> UBound(ary) Then
                    .Range("P2", .Cells(Rows.Count, 16).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                Else
                    .Range("O2", .Cells(Rows.Count, 15).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                End If
            .AutoFilterMode = False
        End With
    Next
End Sub

Do you think you could help me?

Thank you,
John

 

[DanteAmor]

Hi John, fine thanks, and how are you?

Because it is a new topic, you could create a new thread.

 

[John_Gil]

Hi John, fine thanks, and how are you?

Because it is a new topic, you could create a new thread.

Everything perfect thank you!

I have created it already!

Thank you,
John

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.