Scribd
Upload
5 views

Test Auto

Uploaded by

Mohamed Rashad Rouine
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
5 views

Test Auto

Uploaded by

Mohamed Rashad Rouine
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 2

Sub ExtractData()

Dim srcWb As Workbook


Dim destWs As Worksheet
Dim srcWs As Worksheet
Dim lastRow As Long
Dim outputLastRow As Long
Dim tableHeaders As Variant
Dim i As Long

' Set source workbook and sheet


On Error Resume Next
Set srcWb = Workbooks("Classeur1.xlsx") ' Change extension if needed
On Error GoTo 0
If srcWb Is Nothing Then
MsgBox "Classeur1.xlsx is not open. Please open it and try again.",
vbExclamation
Exit Sub
End If

Set srcWs = srcWb.Sheets("Feuil1")


Set destWs = ThisWorkbook.Sheets(1) ' Set this to the appropriate sheet in your
template

' Clear previous data in destination sheet (optional)


destWs.Cells.Clear

' Define the headers for the output table


tableHeaders = Array("A", "G", "Q", "S", "T", "U", "V", "Y")

' Copy headers from source to destination


For i = LBound(tableHeaders) To UBound(tableHeaders)
destWs.Cells(1, i + 1).Value = srcWs.Cells(1,
Columns(tableHeaders(i)).Column).Value
Next i

' Find the last row in source sheet


lastRow = srcWs.Cells(srcWs.Rows.Count, "A").End(xlUp).Row

' Copy data from source sheet to destination sheet based on defined columns
For i = 2 To lastRow ' Start from row 2 to skip headers
outputLastRow = destWs.Cells(destWs.Rows.Count, 1).End(xlUp).Row + 1
destWs.Cells(outputLastRow, 1).Value = srcWs.Cells(i, 1).Value ' Column A -
> A
destWs.Cells(outputLastRow, 2).Value = srcWs.Cells(i, 7).Value ' Column G -
> B
destWs.Cells(outputLastRow, 3).Value = srcWs.Cells(i, 17).Value ' Column Q
-> C
destWs.Cells(outputLastRow, 4).Value = srcWs.Cells(i, 19).Value ' Column S
-> D
destWs.Cells(outputLastRow, 5).Value = srcWs.Cells(i, 20).Value ' Column T
-> E
destWs.Cells(outputLastRow, 6).Value = srcWs.Cells(i, 21).Value ' Column U
-> F
destWs.Cells(outputLastRow, 7).Value = srcWs.Cells(i, 22).Value ' Column V
-> G
destWs.Cells(outputLastRow, 8).Value = srcWs.Cells(i, 25).Value ' Column Y
-> H
Next i
' Sort the data in the destination sheet by column C (3rd column) after header
With destWs.Sort
.SortFields.Clear
.SortFields.Add Key:=destWs.Range("C2:C" & outputLastRow),
Order:=xlAscending
.SetRange destWs.Range("A1:H" & outputLastRow)
.Header = xlYes
.Apply
End With

' Hide columns after H


destWs.Columns("I:Z").EntireColumn.Hidden = True

' Auto-fit the column widths


destWs.Columns("A:H").AutoFit

MsgBox "Data extraction and formatting complete.", vbInformation


End Sub

You might also like

pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy