Excel VBA Macro to Open a Dialog Box to Select a Target File and Copy Desired Columns which Match with the our Workbook Columns
Sub CopyDesiredCols()
Dim TargetFile As Variant
Dim TargetFileName As Variant
Dim Ws As Worksheet
Dim X As Long
Dim Y As Long
Dim Z As Long
Y = ActiveSheet.Columns.Count
TargetFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm", , "Select Your File")
'If TargetFile = False Then Exit Sub
Workbooks.Open (TargetFile)
TargetFileName = ActiveWorkbook.Name
Workbooks(TargetFileName).Activate
For X = 2 To Y
If ThisWorkbook.Sheets("Mydata").Cells(1, X) <> "" Then
For Z = 2 To Y
If LCase(ThisWorkbook.Sheets("Mydata").Cells(1, X)) = LCase(ActiveWorkbook.Sheets("Database").Cells(1, Z)) Then
ActiveWorkbook.Sheets("Database").Cells(1, Z).EntireColumn.Select
Selection.Copy
ThisWorkbook.Sheets("Mydata").Cells(1, X).PasteSpecial Paste:=xlPasteValues
End If
Next Z
End If
Next X
Workbooks(TargetFileName).Save
Workbooks(TargetFileName).Close
MsgBox "DATA Succesfull Copied From " & " " & TargetFileName & vbNewLine _
& "You Can Select Next File", vbInformation, "Success !!!"
Exit Sub
Err:
MsgBox Err.Description
End Sub
Thanks, Tamatam
Sub CopyDesiredCols()
Dim TargetFile As Variant
Dim TargetFileName As Variant
Dim Ws As Worksheet
Dim X As Long
Dim Y As Long
Dim Z As Long
Y = ActiveSheet.Columns.Count
TargetFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm", , "Select Your File")
'If TargetFile = False Then Exit Sub
Workbooks.Open (TargetFile)
TargetFileName = ActiveWorkbook.Name
Workbooks(TargetFileName).Activate
For X = 2 To Y
If ThisWorkbook.Sheets("Mydata").Cells(1, X) <> "" Then
For Z = 2 To Y
If LCase(ThisWorkbook.Sheets("Mydata").Cells(1, X)) = LCase(ActiveWorkbook.Sheets("Database").Cells(1, Z)) Then
ActiveWorkbook.Sheets("Database").Cells(1, Z).EntireColumn.Select
Selection.Copy
ThisWorkbook.Sheets("Mydata").Cells(1, X).PasteSpecial Paste:=xlPasteValues
End If
Next Z
End If
Next X
Workbooks(TargetFileName).Save
Workbooks(TargetFileName).Close
MsgBox "DATA Succesfull Copied From " & " " & TargetFileName & vbNewLine _
& "You Can Select Next File", vbInformation, "Success !!!"
Exit Sub
Err:
MsgBox Err.Description
End Sub
Thanks, Tamatam
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.