Excel Macro

%3CLINGO-SUB%20id%3D%22lingo-sub-1831842%22%20slang%3D%22en-US%22%3EExcel%20Macro%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1831842%22%20slang%3D%22en-US%22%3E%3CP%3EHi%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ERequirement%20%3A%26nbsp%3B%3C%2FP%3E%3CP%3EI%20have%20one%20excel%20file%20say%20Excel-A%20which%20having%20one%20WorkSheet%20Sate%20WS-1%20placed%20at%20my%20Window%20Folder%20and%20i%20want%20to%20copy%20data%20of%20WS-1%20to%20another%20Excel-2%20using%20Macro.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20want%20to%20write%20Macro%20in%20a%20New%20Excel%20Sheet%20and%20will%20call%20Source%20file%20Excel%20-%20A%20from%20there%20and%20then%20need%20to%20filter%20data%20as%20well%20and%20then%20finally%20paste%20to%20Excel-2%20using%20Macro.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPlease%20suggest!!%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThank%3C%2FP%3E%3CP%3EAmit%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1831842%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1834145%22%20slang%3D%22de-DE%22%3ESubject%3A%20Excel%20Macro%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1834145%22%20slang%3D%22de-DE%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F755992%22%20target%3D%22_blank%22%3E%40amsrivas28%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CSPAN%20class%3D%22tlid-translation%20translation%22%3E%3CSPAN%20class%3D%22%22%3EHere%20is%20a%20small%20solution%2C%20maybe%20you%20can%20adapt%20it%20to%20your%20needs.%3C%2FSPAN%3E%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%3CSPAN%20class%3D%22tlid-translation%20translation%22%3E%3CSPAN%20class%3D%22%22%3E%3CSPAN%20class%3D%22%22%3EUntested%3C%2FSPAN%3E%3C%2FSPAN%3E%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3EPrivate%20Function%20GetValue%20(path%20As%20String%2C%20file%20As%20String%2C%20sheet%20As%20String%2C%20reference%20As%20String)%0A%20%20%0A%20%20Dim%20Argument%20As%20String%0A%20%20%0A'Add%20backslash%20if%20not%20available%20...%0A%20%20%0A%20%20If%20Right%20(Path%2C%201)%20%26lt%3B%26gt%3B%20%22%5C%22%20Then%0A%20%20%0A%20%20%20%20Path%20%3D%20path%20%26amp%3B%20%22%5C%22%0A%20%20%20%20%0A%20%20End%20If%0A%20%20%0A'Check%20the%20existence%20of%20the%20file%20...%0A%20%20%0A%20%20If%20Dir%20(path%20%26amp%3B%20file)%20%3D%20%22%22%20Then%0A%20%20%0A%20%20%20%20GetValue%20%3D%20%22File%20not%20found%22%0A%20%20%20%20%0A%20%20%20%20Exit%20function%0A%20%20%20%20%0A%20%20End%20If%0A%20%20%0A'Generate%20argument%20...%0A%20%20%0A%20%20Argument%20%3D%20%22'%22%20%26amp%3B%20path%20%26amp%3B%20%22%5B%22%20%26amp%3B%20file%20%26amp%3B%20%22%5D%22%20%26amp%3B%20sheet%20%26amp%3B%20%22'!%22%20%26amp%3B%20_%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Range%20(reference)%20.Range%20(%22A1%22).%20Address%20(%2C%2C%20xlUp)%0A%20%20%0A'Read%20out%20...%0A%20%20%0A%20%20GetValue%20%3D%20ExecuteExcel4Macro%20(argument)%0A%20%20%0AEnd%20function%0A%0A%0APublic%20Sub%20GetValue_2020%20()%0A%0A%20%20Dim%20path%20As%20String%0A%20%20Dim%20file%20As%20String%0A%20%20Dim%20table%20As%20String%0A%20%20Dim%20Cell%20As%20Range%0A%20%20Dim%20Map%20As%20Worksheet%0A%20%20Dim%20area%20As%20String%0A%20%20%0A'Set%20a%20reference%20to%20the%20folder%20...%0A%20%20%0A%20%20Set%20folder%20%3D%20worksheets%20(%22annual%20plan%22)%0A%20%20%0A'Initialize%20...%0A%20%20%0A%20%20Path%20%3D%20%22W%3A%20%5C%20Z042%20%5C%20042-Absences%20%5C%22%0A%20%20File%20%3D%20%222020.xls%22%0A%20%20Table%20%3D%20%22annual%20plan%22%0A%20%20Range%20%3D%20%22E9%3A%20H391%22%0A%20%20%0A'Loop%20through%20all%20cells%20...%0A%20%20%0A%20%20For%20Each%20Cell%20In%20Book.Range%20(range)%0A%20%20%20%20%0A'Read%20value%20...%0A%20%20%20%20%0A%20%20%20%20Cell.Value%20%3D%20GetValue%20(Path%2C%20File%2C%20Table%2C%20Cell.Address)%0A%20%20%20%20%0A'Do%20not%20accept%20null%20values%0A%20%20%20%20%0A%20%20%20%20If%20IsNumeric%20(Cell.Value)%20Then%0A%20%20%20%20%20%20%0A%20%20%20%20%20%20If%20Cell.Value%20%3D%200%20Then%0A%20%20%20%20%20%20%0A%20%20%20%20%20%20%20%20Cell.ClearContents%0A%20%20%20%20%20%20%0A%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%0A%20%20%20%20End%20If%0A%20%20%20%20%0A%20%20Next%20cell%0A%0A%0A'%20To%20clean%20up...%0A%20%20%0A%20%20Set%20wks%20%3D%20Nothing%0A%20%20%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EHope%20I%20was%20able%20to%20help%20you.%3C%2FP%3E%3CP%3EThank%20you%20for%20your%20understanding%20and%20patience%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ENikolino%3C%2FP%3E%3CP%3EI%20know%20I%20don't%20know%20anything%20(Socrates)%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E*%20Kindly%20Mark%20and%20Vote%20this%20reply%20if%20it%20helps%20please%2C%20as%20it%20will%20be%20beneficial%20to%20more%20community%20members%20reading%20here%3C%2FP%3E%3C%2FLINGO-BODY%3E
Occasional Contributor

Hi,

 

Requirement : 

I have one excel file say Excel-A which having one WorkSheet Sate WS-1 placed at my Window Folder and i want to copy data of WS-1 to another Excel-2 using Macro.

 

I want to write Macro in a New Excel Sheet and will call Source file Excel - A from there and then need to filter data as well and then finally paste to Excel-2 using Macro.

 

Please suggest!!

 

Thank

Amit

1 Reply

@amsrivas28 

Here is a small solution, maybe you can adapt it to your needs.

Untested

 

 

Private Function GetValue (path As String, file As String, sheet As String, reference As String)
  
  Dim Argument As String
  
'Add backslash if not available ...
  
  If Right (Path, 1) <> "\" Then
  
    Path = path & "\"
    
  End If
  
'Check the existence of the file ...
  
  If Dir (path & file) = "" Then
  
    GetValue = "File not found"
    
    Exit function
    
  End If
  
'Generate argument ...
  
  Argument = "'" & path & "[" & file & "]" & sheet & "'!" & _
                   Range (reference) .Range ("A1"). Address (,, xlUp)
  
'Read out ...
  
  GetValue = ExecuteExcel4Macro (argument)
  
End function


Public Sub GetValue_2020 ()

  Dim path As String
  Dim file As String
  Dim table As String
  Dim Cell As Range
  Dim Map As Worksheet
  Dim area As String
  
'Set a reference to the folder ...
  
  Set folder = worksheets ("annual plan")
  
'Initialize ...
  
  Path = "W: \ Z042 \ 042-Absences \"
  File = "2020.xls"
  Table = "annual plan"
  Range = "E9: H391"
  
'Loop through all cells ...
  
  For Each Cell In Book.Range (range)
    
'Read value ...
    
    Cell.Value = GetValue (Path, File, Table, Cell.Address)
    
'Do not accept null values
    
    If IsNumeric (Cell.Value) Then
      
      If Cell.Value = 0 Then
      
        Cell.ClearContents
      
      End If
      
    End If
    
  Next cell


' To clean up...
  
  Set wks = Nothing
  
End Sub

 

 

 

Hope I was able to help you.

Thank you for your understanding and patience

 

Nikolino

I know I don't know anything (Socrates)

 

* Kindly Mark and Vote this reply if it helps please, as it will be beneficial to more Community members reading here