Help to modify VBA Code

Hi All,

I appreciate if anyone can help me. I have a VBA code in the "downloaded report". If I run it, the code will copy "pivot table look like" sheet and paste in the same workbook by creating a new sheet. This works great and have no issue.

In addition, I also want to save this data in the last available row of another workbook called "Master Data" and add week # in the first column. The week # can be taken from the downloaded report.

I have attached both workbook for reference. Please advice.

Regards

Sha

Attachment 12867Attachment 12868

Code:

---

Sub test()
Dim sh As Worksheet
Dim shData As Worksheet
Dim shMaster As Worksheet
Dim data, result, production, igroup, article, vl
Dim rowMasterLast As Long, rowsData As Long
Dim lrow As Long, i As Long, j As Long, n As Long, k As Integer

    If IsError(Evaluate("'Downloaded report'!A1")) Then Exit Sub
   
    Set sh = Sheets("Downloaded report")
    With sh
   
        lrow = .UsedRange.Rows.Count
        If lrow < 10 Then Exit Sub
       
        data = .Range("b1:o" & lrow)
       
        ReDim result(1 To lrow, 1 To 14)
       
        result(1, 1) = data(2, 4)
        result(2, 1) = data(4, 5)
        result(3, 1) = "week#"
        result(4, 1) = "Date"
        result(3, 2) = data(8, 14)
        result(4, 2) = Format(data(9, 14), "[$-10407]dd-mm")
       
        For Each vl In Array(1, 6, 7, 9, 11, 12, 13)
       
            k = k + 1
            result(6, k) = data(9, vl)
        Next
        result(6, k + 1) = "Qty"
       
        j = 6
        For i = 10 To lrow
       
            If data(i, 1) <> "" Then production = data(i, 1)
            If data(i, 6) <> "" Then igroup = data(i, 6)
            If data(i, 7) <> "" Then
           
                article = data(i, 7)
                j = j + 1
                result(j, 1) = production
                result(j, 2) = igroup
                result(j, 3) = article
                k = 3
                For Each vl In Array(9, 11, 12, 13, 14)
               
                    k = k + 1
                    result(j, k) = data(i, vl)
                Next
            End If
        Next
    End With
   
    Application.ScreenUpdating = False
   
    Set shMaster = Workbooks("Master Data.xls").Worksheets("Master Data")
    rowMasterLast = shMaster.Range("A1").End(xlDown).Row
       
    Set shData = Worksheets.Add
    With shData
   
        rowsData = j - 6
       
        .Range("a1:h" & j) = result
       
        .Range("a1,a3,a4,b4, a6:h6").Font.Bold = 1
        .Range("a3:b4").HorizontalAlignment = xlCenter
        .Range("a6:h" & j).Borders.LineStyle = xlContinuous
        .Range("a6:h" & j).Columns.AutoFit
       
        .Cells(7, "A").Resize(rowsData, 8).Copy shMaster.Cells(rowMasterLast + 1, "B")
        shMaster.Cells(rowMasterLast + 1, "A").Resize(rowsData).Value = .Range("B3").Value
        shMaster.Rows(rowMasterLast).Copy
        shMaster.Cells(rowMasterLast + 1, "A").Resize(rowsData).PasteSpecial Paste:=xlPasteFormats
    End With
   
    Application.CutCopyModemode = False
    Application.ScreenUpdating = True
End Sub

---

beaten to it by xld!
Master Data.xls should already be open.

Code:

---

Sub test()
Dim sh As Worksheet, NewSht As Worksheet, lrow As Long, data, result, i As Long, j As Long, production, igroup, article, n As Long, k As Integer, vl
Dim DestnSht As Worksheet, DestnCell As Range

If IsError(Evaluate("'Downloaded report'!A1")) Then Exit Sub
Set sh = Sheets("Downloaded report")
lrow = sh.UsedRange.Rows.Count
If lrow < 10 Then Exit Sub

data = sh.Range("b1:o" & lrow)
ReDim result(1 To lrow, 1 To 14)

result(1, 1) = data(2, 4)
result(2, 1) = data(4, 5)
result(3, 1) = "week#"
result(4, 1) = "Date"
result(3, 2) = data(8, 14)
result(4, 2) = Format(data(9, 14), "[$-10407]dd-mm")

For Each vl In Array(1, 6, 7, 9, 11, 12, 13)
  k = k + 1
  result(6, k) = data(9, vl)
Next

result(6, k + 1) = "Qty"
j = 6
For i = 10 To lrow
  If data(i, 1) <> "" Then production = data(i, 1)
  If data(i, 6) <> "" Then igroup = data(i, 6)
  If data(i, 7) <> "" Then
    article = data(i, 7)
    j = j + 1
    result(j, 1) = production
    result(j, 2) = igroup
    result(j, 3) = article
    k = 3
    For Each vl In Array(9, 11, 12, 13, 14)
      k = k + 1
      result(j, k) = data(i, vl)
    Next
  End If
Next

Application.ScreenUpdating = 0

Set NewSht = Sheets.Add
With NewSht
  .Range("a1:h" & j) = result
  .Range("a1,a3,a4,b4, a6:h6").Font.Bold = 1
  .Range("a3:b4").HorizontalAlignment = xlCenter
  .Range("a6:h" & j).Borders.LineStyle = xlContinuous
  .Range("a6:h" & j).Columns.AutoFit
  Set DestnSht = Workbooks("Master Data.xls").Sheets("Master Data")
  With DestnSht
    Set DestnCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
  End With
  .Range("a7:h" & j).Copy DestnCell.Offset(, 1)
  With DestnCell.Resize(j - 6)
    .Value = data(8, 14)
    .Borders.LineStyle = xlContinuous
    .HorizontalAlignment = xlCenter
  End With
End With
Application.ScreenUpdating = 1
End Sub

---

WoW.. That's work great.

Just a small changes in the code for added functionality.

Can I put this Code into a Different file and When I run the code, it ask me to pick the source file "downloaded report" to copy data from.

Once it select the source file, rather then creating Worksheet in the "downloaded report", it let me pick First excel file and save in tab "abc". Once its done, it then let me pick second Excel file "master Data" and save in the last available row.

Hope I am not asking too much changes in the above code.

Regards

Sha

Who are you directing that at, me or p45cal?

Well I tried both and both code works

anyone can help me if it's okay?

Well Thank you both of you

Second Part i have sorted out myself.

Thank you once again.

Regards

Sha

Well Thank you both of you

Second Part i have sorted out myself.

Thank you once again. but how i can acknowledge your effort ?

Regards

Sha

Quote:

---

Originally Posted by shido

but how i can acknowledge your effort ?

---

You already have, just by replying