rcastilho91
01-26-2016, 12:03 PM
Hey, guys.
I'm here because of an issue that's driven me nuts and I just can't seem to find a solution, although it's probably pretty simple. I can't find any similar issues, so here it goes.
To summarize, let's assume there is a report that comes in regularly and has 100 columns. I need only 5 of those. As to simplify the process, I've created a routine that goes pretty much like this:
1. In one Excel sheet, I have the titles of the headers I want to copy. The code reads the content in the header, searches for it in the source Excel, copies the entire content, goes back to the destination Excel and pastes it.
It works beautifully, except for one detail: it messes up the first line, every single time. In a very simple example, let's say this is the case:
Before importing:
Source:
Name
Number
John
20
Cena
16
How it's imported to the destination table:
Name
Number
TRUE
TRUE
Cena
16
Admit that, of course, there are dozens and dozens of rows. But the contents of the first one is always replaced by TRUE in every cell, and the rest is copied properly. With that said, the code can be found below:
Sub importdata()
Dim wbBook As ThisWorkbook
Dim wbImportMe As Workbook
Dim HeaderContent
Dim Rng As Range
Dim SrcRng As Range
'Declaring which are the worksheets
Set wbImportMe = Workbooks.Open("C:\Users\RCO1\Desktop\Teste VBA\2. Conceptual Testing\1. Excel to Excel Importing\Importme.xlsb")
Set wbBook = ThisWorkbook
'Establishing starting point in destination sheet
Set Rng = wbBook.Sheets("Sheet1").Range("A1")
'Establishing variable to retain text to be searched
HeaderContent = Rng.Value
'Procedure to search, copy and paste values while there are cells with content
Do While HeaderContent <> ""
'Activates source sheet
wbImportMe.Activate
wbImportMe.Sheets("ps (98)").Activate
'Seeks content stored in the variable
Cells.Find(What:=HeaderContent, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'Skips to the next row after finding the header
Set SrcRng = ActiveCell.Offset(1, 0)
'Selects and copies the entire column
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Activates destination sheet
wbBook.Activate
wbBook.Sheets("Sheet1").Activate
'Selects current position where the header is, goes down a row and pastes the content
Rng.Select
Set Rng = ActiveCell.Offset(1, 0)
ActiveSheet.Paste
'Finds content back in destination sheet
Rng = Cells.Find(What:=HeaderContent, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'Selects the next header in X axis, activates it and redefines the variable to it
Set Rng = ActiveCell.Offset(0, 1)
Rng.Select
HeaderContent = Rng.Value
'Loops until empty header is found
Loop
'Closes source table
wbImportMe.Close
End Sub
If you guys can see my mistake, I'd highly appreciate if you could point it out.
Thanks a lot!
I'm here because of an issue that's driven me nuts and I just can't seem to find a solution, although it's probably pretty simple. I can't find any similar issues, so here it goes.
To summarize, let's assume there is a report that comes in regularly and has 100 columns. I need only 5 of those. As to simplify the process, I've created a routine that goes pretty much like this:
1. In one Excel sheet, I have the titles of the headers I want to copy. The code reads the content in the header, searches for it in the source Excel, copies the entire content, goes back to the destination Excel and pastes it.
It works beautifully, except for one detail: it messes up the first line, every single time. In a very simple example, let's say this is the case:
Before importing:
Source:
Name
Number
John
20
Cena
16
How it's imported to the destination table:
Name
Number
TRUE
TRUE
Cena
16
Admit that, of course, there are dozens and dozens of rows. But the contents of the first one is always replaced by TRUE in every cell, and the rest is copied properly. With that said, the code can be found below:
Sub importdata()
Dim wbBook As ThisWorkbook
Dim wbImportMe As Workbook
Dim HeaderContent
Dim Rng As Range
Dim SrcRng As Range
'Declaring which are the worksheets
Set wbImportMe = Workbooks.Open("C:\Users\RCO1\Desktop\Teste VBA\2. Conceptual Testing\1. Excel to Excel Importing\Importme.xlsb")
Set wbBook = ThisWorkbook
'Establishing starting point in destination sheet
Set Rng = wbBook.Sheets("Sheet1").Range("A1")
'Establishing variable to retain text to be searched
HeaderContent = Rng.Value
'Procedure to search, copy and paste values while there are cells with content
Do While HeaderContent <> ""
'Activates source sheet
wbImportMe.Activate
wbImportMe.Sheets("ps (98)").Activate
'Seeks content stored in the variable
Cells.Find(What:=HeaderContent, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'Skips to the next row after finding the header
Set SrcRng = ActiveCell.Offset(1, 0)
'Selects and copies the entire column
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Activates destination sheet
wbBook.Activate
wbBook.Sheets("Sheet1").Activate
'Selects current position where the header is, goes down a row and pastes the content
Rng.Select
Set Rng = ActiveCell.Offset(1, 0)
ActiveSheet.Paste
'Finds content back in destination sheet
Rng = Cells.Find(What:=HeaderContent, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'Selects the next header in X axis, activates it and redefines the variable to it
Set Rng = ActiveCell.Offset(0, 1)
Rng.Select
HeaderContent = Rng.Value
'Loops until empty header is found
Loop
'Closes source table
wbImportMe.Close
End Sub
If you guys can see my mistake, I'd highly appreciate if you could point it out.
Thanks a lot!