Untitled - Posted on November Wed 25th 12:51 AM (Never Expires) - Format: text
  1.                 Sub CopyCellsDown(StartRange As Range)
  2.  
  3.   Dim targetRange As Range
  4.  
  5.   ' the startRange should be a range object that points to the first cell
  6.   ' this is the only cell that you have to set - everything else is automatic
  7.   ' the call will look like: CopyCellsDown (ActiveSheet.Range("H2"))
  8.    
  9.   ' looks complicated - but only just using offset to specify the start and
  10.   ' end of the range we want to pass to the autofill.
  11.   Set targetRange = Range(StartRange, StartRange.Offset(0, -1).End(xlDown).Offset(0, 1))
  12.  
  13.   'this selects the starting cell
  14.   StartRange.Select
  15.  
  16.   'this copies down the value down to as many rows as the column on the left
  17.   Selection.AutoFill Destination:=targetRange
  18. End Sub
  19.  
  20. Sub refresh_SFTBL2()
  21. 'it is find Dec-21 and copy until it
  22. Dim SFPLanValue
  23.  SFPLanValue = InputBox("Type name of plan", "Plan", "SF")
  24.  
  25.  For i = 0 To 100
  26.         Debug.Print ""
  27.     Next i
  28.  
  29. Set wbTh = ThisWorkbook
  30. Set wbSF = GetObject(lastSF22book())
  31.  
  32. Dim rowL
  33. Dim rowU
  34. 'rowOfData
  35. Set Rng = wbTh.Worksheets("SF TBL2").ListObjects("Table6").Range
  36. 'MsgBox Col_Letter(Rng.Columns(Rng.Columns.Count).Column + 1)
  37. '.Range(Col_Letter(Rng.Columns(Rng.Columns.Count).Column + 1) & ":I").Clear
  38. 'MsgBox wbTh.Worksheets("WK TBL").ListObjects("Table3").DataBodyRange.Address
  39. 'wbTh.Worksheets("Dashboard").ListObjects("Table5").DataBodyRange.Clear
  40.  
  41.   Dim sArray(4) As String
  42.     Dim element As Variant
  43.     Dim RangeCell
  44.  sArray(0) = "Kit": sArray(1) = "HTS": sArray(2) = "SLU": sArray(3) = "Other": sArray(4) = "P4"
  45.  
  46.  
  47.  With wbTh.Worksheets("SF TBL2")
  48.     .Activate
  49.     Set Macro_ParameterCell = .Range("1:1").Find(What:="Parameter", LookIn:=xlValues)
  50.         If Macro_ParameterCell Is Nothing Then
  51.             MsgBox ("Ooooooopppps")
  52.               End If
  53.  End With
  54.       'Debug.Print Rng.Rows(Rng.Rows.Count).Row + 1
  55.       'rowU = Rng.Rows(Rng.Rows.Count).Row + 1
  56.       'Exit Sub
  57.      'rowU = Macro_ParameterCell.Row + 1
  58. '''''''''''''
  59.     For Each element In sArray
  60.    
  61.     Set Rng = wbTh.Worksheets("SF TBL2").ListObjects("Table6").Range
  62.     rowU = Rng.Rows(Rng.Rows.Count).Row + 1
  63.    
  64.         'If element = "SLU" Then Exit For
  65.    
  66.         Debug.Print element
  67.         Debug.Print "!"
  68.         With wbSF.Worksheets(element)
  69.         .Activate
  70.         If .AutoFilterMode = True Then  'add autofilter if doesn't exist
  71.  
  72.         'Do Nothing
  73.        
  74.         Else
  75.        
  76.         .Range("A2").AutoFilter
  77.        
  78.         End If
  79.        
  80.               On Error Resume Next
  81.                'Cells.AutoFilter
  82. If ActiveSheet.AutoFilterMode Then ActiveSheet.ShowAllData
  83. On Error GoTo 0
  84.  
  85.         Set FindCell = .Range("2:2").Find(What:="Parameter", LookIn:=xlValues)
  86.         If FindCell Is Nothing Then
  87.             MsgBox ("Ooooooopppps")
  88.         End If
  89.        
  90.          
  91.              Set FindCell22 = .Range("2:2").Find(What:="Dec-21", LookIn:=xlValues)  'date Dec-21
  92.         If FindCell22 Is Nothing Then
  93.             MsgBox ("Ooooooopppps")
  94.         End If
  95.                .Columns(4).AutoFilter Field:=FindCell.Column, Criteria1:=Array( _
  96.         "IMS", "Offtakes", "Shipment"), Operator:=xlFilterValues     'Columns(4) stands for nothing
  97.         'Exit Sub
  98.          'Exit Sub
  99.       '   MsgBox FindCell22.Column
  100.           rowL = .Cells(.Rows.Count, FindCell.Column).End(xlUp).Row
  101.          
  102.             Set RangeCell = .Range(.Cells(FindCell.Row + 1, FindCell.Column), .Cells(rowL, FindCell22.Column))
  103.         End With
  104.        
  105.         RangeCell.Copy
  106.         Debug.Print RangeCell.Address
  107.         ''''''''''''''''''''''''''''''''''''''''''''''''
  108.         'wbTh.Worksheets("Dashboard").ListObjects("Table5").Resize Range("A1:AF3")
  109.        
  110.     With wbTh.Worksheets("SF TBL2")
  111.     .Activate
  112.     Set Macro_ParameterCell = .Range("1:1").Find(What:="Parameter", LookIn:=xlValues)
  113.         If Macro_ParameterCell Is Nothing Then
  114.             MsgBox ("Ooooooopppps")
  115.         End If
  116.         RangeCell.Copy
  117.         'MsgBox Macro_ParameterCell.Row '.Cells(Macro_ParameterCell.Row+1, Macro_ParameterCell.Column)
  118.         .Range(.Cells(rowU, Macro_ParameterCell.Column), .Cells(rowU, Macro_ParameterCell.Column)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
  119.         , SkipBlanks:=False, Transpose:=False
  120.         .Range(.Cells(rowU, Macro_ParameterCell.Column), .Cells(rowU, Macro_ParameterCell.Column)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  121.         :=False, Transpose:=False
  122.     End With
  123. Application.CutCopyMode = False
  124.  
  125.        
  126.        
  127.        
  128.        
  129.         'Exit Sub
  130.    
  131. ''''        With wbTh.Worksheets("Dashboard")
  132. ''''
  133. ''''            'rowU = rowU + RangeCell.Rows.Count
  134. ''''            'rowU + 250
  135. ''''            'wbTh.Worksheets("Dashboard").Cells(.Rows.Count, Macro_ParameterCell.Column).End(xlUp).Row + 1
  136. ''''
  137. ''''        End With
  138.        Debug.Print "rowU"
  139.        Debug.Print rowU
  140.        Debug.Print SFPLanValue
  141.           'Exit Sub
  142.            wbTh.Worksheets("SF TBL2").Range("B" & rowU).Value = "=""" & SFPLanValue & """"
  143.            CopyCellsDown (wbTh.Worksheets("SF TBL2").Range("B" & rowU))
  144.            'wbTh.Worksheets("SF TBL2").Range("B" & rowU).FillDown
  145.     Next element
  146. ''''''''''''
  147.     Debug.Print "Done"
  148. With wbTh.Worksheets("SF TBL2")
  149.   Do While True
  150.     Set FindCell3 = .Range("F:F").Find(What:="Total", LookIn:=xlValues)
  151.         If FindCell3 Is Nothing Then
  152.             Exit Do
  153.         End If
  154.      .Rows(FindCell3.Row).Delete
  155.   Loop
  156. End With
  157.  
  158.   Debug.Print "Done 2 "
  159.  
  160.     Exit Sub
  161.  
  162.  
  163. ''''     wbTh.Worksheets("Dashboard").Range("B2").Value = "=VLOOKUP([@Category]&[@Version]&[@SKU],Library!A:B,2,0)"
  164. ''''     wbTh.Worksheets("Dashboard").Range("C2").Value = "=VLOOKUP([@Parameter],Library!C:D,2,0)"
  165.        
  166.     ' =VLOOKUP(A2,'[" & sbs_name & "]" & sh_wbSbS.Name & "'!$A:$" & Col_Letter(FindCell.Column) & "," & FindCell.Column & ",0)"
  167. '''  '.Range(v_SF_emptyWK_cell.Address).Value = "=VLOOKUP(A2,[" & sbs_name & "]" & sh_wbSbS.Name & "!$A:$" & Col_Letter(FindCell.Column) & "," & FindCell.Column & ",0)"
  168. '''  .Range(v_SF_emptyWK_cell.Address).AutoFill .Range(v_SF_emptyWK_cell, v_SF_emptyWK_fillTo_cell)
  169. '''
  170.  
  171. '''With wbSF.Worksheets("Supply")
  172. '''    rowL = .Cells(.Rows.Count, 4).End(xlUp).Row
  173. '''End With
  174. '''wbSF.Worksheets("Supply").Range("A6:AW" & rowL).Copy
  175. '''
  176. '''wbTh.Worksheets("WK TBL").Range("B2").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
  177. '''        , SkipBlanks:=False, Transpose:=False
  178. '''    wbTh.Worksheets("WK TBL").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  179. '''        :=False, Transpose:=False
  180. '''Application.CutCopyMode = False
  181. ''''MsgBox wbSF.Worksheets("Supply").Range("A6:BQ" & rowL).Address
  182. '''Exit Sub
  183. '''wbTh.Worksheets("WK TBL").Range("B2:BR596").Value = wbSF.Worksheets("Supply").Range("A6:BQ600").Value
  184. '''wbTh.Worksheets("WK TBL").Activate
  185. '''wbTh.Worksheets("WK TBL").Range(Col_Letter(Rng.Columns(Rng.Columns.Count).Column + 1) & ":BR").Select
  186. '''    Application.CutCopyMode = False
  187. '''    Selection.Delete Shift:=xlToLeft
  188. ''''Exit Sub
  189. '''MsgBox wbSF.Name
  190. End Sub

New Paste

Paste Options

Recent Pastes

3 days ago

Untitled

8 days ago

Untitled

11 days ago

30 jours max

14 days ago

Untitled

32 days ago

Untitled

34 days ago

Untitled

34 days ago

Untitled

34 days ago

Jazz

34 days ago

Untitled

35 days ago

Untitled