Excel VBA - Move data based on column

L

longtimelurker

New Member
Joined
Feb 9, 2014
Messages
13
Hi Guys,

Long time lurker here (^_^)

I have been getting by for a year or so now but in need of some help :)

At work, I have columns under specific names at a random row. "Description" is a header name for example.

I need everything under Description to go to (C:2) in sheet2

I am trying to have excel search by name, aka Description in sheet 1, then move all data under it to C:2

(there are 10 other headers)

So that's really it :) Because it's random row, I can no longer use hard code :(

Feel free to ask any questions, or if pictures are needed, etc ask away!

Thank you Mrexcel forums.
 
Sort by date Sort by votes
Hi Hiker95,

I made a new workbook (14kb this time, hopefully it's okay?)
https://app.box.com/s/nm9qjvk1zkj2dc6kvur6

QUOTE sheet is the sheet that is sent to us.
Sheet1 has all the columns needed to be transferred.
Result sheet is the sheet which it needs to look like after the process

The idea I was thinking of, was somehow -->
Look for titles in sheet1 in quote sheet, return the columns of the titles found back into sheet1

I can't just do copy/paste because the "QUOTE" sheet is sometimes random, as in, the columns can be in different locations sometimes :( otherwise I could copy paste directly.

Let me know if I can give any more info! thank you very much.

https://app.box.com/s/nm9qjvk1zkj2dc6kvur6

Edit: Yes! the last row will always be the same for each column
 
Upvote 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
longtimelurker,

Thanks for the workbook.

1. Both worksheets, QUOTE, and, Sheet1, have their titles in row 1?

2. QUOTE contains titles in random locations?

3. Sheet1 contains its titles in locked/standard locations?

4. Some of the title names are different in both sheets (per the screenshot below)?

The YELLOW colored title cells have the same name in both worksheets.

The OTHER colored title cells is what makes this very interesting to code.

5. Is the below screenshot accurate (even though the data is displayed vertically to fit on the MrExcel format)?


Excel 2007
ABCDE
1QUOTE sheet is the sheet that is sent to us.Sheet1 has all the columns needed to be transferred.
2results worksheet columns
3column locations are randomASKU
4DescriptionBDescription
5SVC STD Brocade 320 SW 8port 8SWL 8Gb BR SFPSVC STD Brocade 320 SW 8port 8SWL 8Gb BR SFP
6
7Service CodeCCovered SKU
8301-001923-01.P301-001923-01.P
9
10Serial NumberDSerial No
11ALJ2503H133ALJ2503H133
12
13Start DateEStart Date
141-Jan-141-Jan-14
15
16End DateFEnd Date
1731-Dec-1431-Dec-14
18
19QTYGQty
2011
21
22BuyHBuy Price
23$ 100.12$ 100.12
24
25IRetail Price
26JSell Price
27KService Contract No
28
29Service LevelLService Level
30StandardStandard
31
32SiteMHost Name
33R027234R027234
34
35NEndUser Location
36
Instructions
 
Upvote 0
hiker95 said:
longtimelurker,

Thanks for the workbook.

1. Both worksheets, QUOTE, and, Sheet1, have their titles in row 1?

2. QUOTE contains titles in random locations?

3. Sheet1 contains its titles in locked/standard locations?

4. Some of the title names are different in both sheets (per the screenshot below)?

The YELLOW colored title cells have the same name in both worksheets.

The OTHER colored title cells is what makes this very interesting to code.

5. Is the below screenshot accurate (even though the data is displayed vertically to fit on the MrExcel format)?

Excel 2007
ABCDE
1QUOTE sheet is the sheet that is sent to us. Sheet1 has all the columns needed to be transferred.
2results worksheet columns
3column locations are randomASKU
4DescriptionBDescription
5SVC STD Brocade 320 SW 8port 8SWL 8Gb BR SFPSVC STD Brocade 320 SW 8port 8SWL 8Gb BR SFP
6
7Service CodeCCovered SKU
8301-001923-01.P301-001923-01.P
9
10Serial NumberDSerial No
11ALJ2503H133ALJ2503H133
12
13Start DateEStart Date
141-Jan-141-Jan-14
15
16End DateFEnd Date
1731-Dec-1431-Dec-14
18
19QTYGQty
2011
21
22BuyHBuy Price
23 $ 100.12 $ 100.12
24
25IRetail Price
26JSell Price
27KService Contract No
28
29Service LevelLService Level
30StandardStandard
31
32SiteMHost Name
33R027234R027234
34
35NEndUser Location
36

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Instructions​
Click to expand...

hi Hiker95,

You have taken my poor instructions, and completely nailed it!

Completely correct! Titles are in first row of worksheets, always.
The name are corresponded correctly as you have shown.

Sheet1 is always locked in.

QUOTE however, has it's titles in random locations.

And the titles in Sheet1 have to remain as those names.

1. I agree the coding would probably be very, difficult.

2. If it helps, the tab "QUOTE" can be edited by the macro in ANY way, the Sheet1 just has to capture the info.

3. All information in QUOTE tab can be cut up any way at all, as long as Sheet1 captures all necessary info, QUOTE tab is expendable, Sheet1 has to maintain it's format/end up with all of the info from QUOTE tab.


Thank you for all your time so far, brilliant help :)
 
Upvote 0
longtimelurker,

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code: 
Option Explicit
Sub ReorgData()
' hiker95, 02/12/2014, ME756540
Dim lr As Long, nr As Long, strColName As String
Dim w1derng As Range, wqderng As Range
Dim w1skrng As Range, wqskrng As Range
Dim w1snrng As Range, wqsnrng As Range
Dim w1sdrng As Range, wqsdrng As Range
Dim w1edrng As Range, wqedrng As Range
Dim w1qtrng As Range, wqqtrng As Range
Dim w1burng As Range, wqburng As Range
Dim w1slrng As Range, wqslrng As Range
Dim w1sirng As Range, wqsirng As Range
With Sheets("Sheet1")
  Set w1derng = .Rows(1).Find("Description", LookAt:=xlWhole)
  Set w1skrng = .Rows(1).Find("Covered SKU", LookAt:=xlWhole)
  Set w1snrng = .Rows(1).Find("Serial No", LookAt:=xlWhole)
  Set w1sdrng = .Rows(1).Find("Start Date", LookAt:=xlWhole)
  Set w1edrng = .Rows(1).Find("End Date", LookAt:=xlWhole)
  Set w1qtrng = .Rows(1).Find("Qty", LookAt:=xlWhole)
  Set w1burng = .Rows(1).Find("Buy Price", LookAt:=xlWhole)
  Set w1slrng = .Rows(1).Find("Service Level", LookAt:=xlWhole)
  Set w1sirng = .Rows(1).Find("Host Name", LookAt:=xlWhole)
  If (w1derng Is Nothing) * (w1skrng Is Nothing) * (w1snrng Is Nothing) _
        * (w1sdrng Is Nothing) * (w1edrng Is Nothing) * (w1qtrng Is Nothing) _
        * (w1burng Is Nothing) * (w1slrng Is Nothing) * (w1sirng Is Nothing) Then
    MsgBox "At least one of the 9 titles in sheet 'Sheet1' is missing - macro terminated!"
    Exit Sub
  End If
End With
With Sheets("QUOTE")
  Set wqderng = .Rows(1).Find("Description", LookAt:=xlWhole)
  Set wqskrng = .Rows(1).Find("Service Code", LookAt:=xlWhole)
  Set wqsnrng = .Rows(1).Find("Serial Number", LookAt:=xlWhole)
  Set wqsdrng = .Rows(1).Find("Start Date", LookAt:=xlWhole)
  Set wqedrng = .Rows(1).Find("End Date", LookAt:=xlWhole)
  Set wqqtrng = .Rows(1).Find("Qty", LookAt:=xlWhole)
  Set wqburng = .Rows(1).Find("Buy", LookAt:=xlWhole)
  Set wqslrng = .Rows(1).Find("Service Level", LookAt:=xlWhole)
  Set wqsirng = .Rows(1).Find("Site", LookAt:=xlWhole)
  If (wqderng Is Nothing) * (wqskrng Is Nothing) * (wqsnrng Is Nothing) _
        * (wqsdrng Is Nothing) * (wqedrng Is Nothing) * (wqqtrng Is Nothing) _
        * (wqburng Is Nothing) * (wqslrng Is Nothing) * (wqsirng Is Nothing) Then
    MsgBox "At least one of the 9 titles in sheet 'QUOTE' is missing - macro terminated!"
    Exit Sub
  ElseIf (Not wqderng Is Nothing) * (Not wqskrng Is Nothing) * (Not wqsnrng Is Nothing) _
        * (Not wqsdrng Is Nothing) * (Not wqedrng Is Nothing) * (Not wqqtrng Is Nothing) _
        * (Not wqburng Is Nothing) * (Not wqslrng Is Nothing) * (Not wqsirng Is Nothing) Then
    
    lr = .Cells(Rows.Count, wqderng.Column).End(xlUp).Row
    strColName = Replace(.Cells(1, w1derng.Column).Address(0, 0), 1, "")
    nr = Sheets("Sheet1").Range(strColName & Rows.Count).End(xlUp).Offset(1).Row
    .Range(.Cells(2, wqderng.Column), .Cells(lr, wqderng.Column)).Copy Sheets("Sheet1").Cells(nr, w1derng.Column)
    .Range(.Cells(2, wqskrng.Column), .Cells(lr, wqskrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1skrng.Column)
    .Range(.Cells(2, wqsnrng.Column), .Cells(lr, wqsnrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1snrng.Column)
    .Range(.Cells(2, wqsdrng.Column), .Cells(lr, wqsdrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1sdrng.Column)
    .Range(.Cells(2, wqedrng.Column), .Cells(lr, wqedrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1edrng.Column)
    .Range(.Cells(2, wqqtrng.Column), .Cells(lr, wqqtrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1qtrng.Column)
    .Range(.Cells(2, wqburng.Column), .Cells(lr, wqburng.Column)).Copy Sheets("Sheet1").Cells(nr, w1burng.Column)
    .Range(.Cells(2, wqslrng.Column), .Cells(lr, wqslrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1slrng.Column)
    .Range(.Cells(2, wqsirng.Column), .Cells(lr, wqsirng.Column)).Copy Sheets("Sheet1").Cells(nr, w1sirng.Column)
  End If
End With
With Sheets("Sheet1")
  .Columns.AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.
 
Upvote 0
Private Message from longtimelurker,

Thank you!

Hey Hiker95!

So it doesn't look like I'm just bumping a thread, I just wanted to say thank you!

That works perfectly, and I am just figuring out how it all works and processes
(so I dont bother people with my english, I am trying to learn as much as possible)

quick question, in the code, how does it know which column relates to each other? seeing as they have different names?

thanks

Longtimelurker
 
Upvote 0
longtimelurker,

I will re-post the macro with an explanation/answer to your question.

Have a great day,
hiker95
 
Upvote 0
longtimelurker,

I hope the below code and descriptions will help you to understand what the macro is doing.

The code is not being displayed the we use the code tags, because, the text alignment comes out strange, and, not lined up.


Option Explicit
Sub ReorgData()
' hiker95, 02/12/2014, ME756540
Dim lr As Long, nr As Long, strColName As String


' The following are the range objects for both worksheets
' Sheet1 = w1 QUOTE = wq
' =w1 =wq
Dim w1derng As Range, wqderng As Range
Dim w1skrng As Range, wqsrng As Range
Dim w1snrng As Range, wqsnrng As Range
Dim w1sdrng As Range, wqsdrng As Range
Dim w1edrng As Range, wqedrng As Range
Dim w1qtrng As Range, wqqtrng As Range
Dim w1burng As Range, wqburng As Range
Dim w1slrng As Range, wqslrng As Range
Dim w1sirng As Range, wqsirng As Range


With Sheets("Sheet1")

' We want to set the range objects, find the range
' range objects for these Sheet1 titles
' in Row 1 |
' |
Set w1derng = .Rows(1).Find("Description", LookAt:=xlWhole)
Set w1skrng = .Rows(1).Find("Covered SKU", LookAt:=xlWhole)
Set w1snrng = .Rows(1).Find("Serial No", LookAt:=xlWhole)
Set w1sdrng = .Rows(1).Find("Start Date", LookAt:=xlWhole)
Set w1edrng = .Rows(1).Find("End Date", LookAt:=xlWhole)
Set w1qtrng = .Rows(1).Find("Qty", LookAt:=xlWhole)
Set w1burng = .Rows(1).Find("Buy Price", LookAt:=xlWhole)
Set w1slrng = .Rows(1).Find("Service Level", LookAt:=xlWhole)
Set w1sirng = .Rows(1).Find("Host Name", LookAt:=xlWhole)


' If at least one of the range objects Is Nothing, means that it was not found
' in worksheet Sheet1, then, we get a message box to give us a warning, and,
' then terminate the macro.
'
If (w1derng Is Nothing) * (w1skrng Is Nothing) * (w1snrng Is Nothing) _
* (w1sdrng Is Nothing) * (w1edrng Is Nothing) * (w1qtrng Is Nothing) _
* (w1burng Is Nothing) * (w1slrng Is Nothing) * (w1sirng Is Nothing) Then
MsgBox "At least one of the 9 titles in sheet 'Sheet1' is missing - macro terminated!"
Exit Sub
End If
End With


With Sheets("QUOTE")


' We want to set the range objects, find the range
' range objects for these QUOTE titles
' in Row 1 |
' |
Set wqderng = .Rows(1).Find("Description", LookAt:=xlWhole)
Set wqskrng = .Rows(1).Find("Service Code", LookAt:=xlWhole)
Set wqsnrng = .Rows(1).Find("Serial Number", LookAt:=xlWhole)
Set wqsdrng = .Rows(1).Find("Start Date", LookAt:=xlWhole)
Set wqedrng = .Rows(1).Find("End Date", LookAt:=xlWhole)
Set wqqtrng = .Rows(1).Find("Qty", LookAt:=xlWhole)
Set wqburng = .Rows(1).Find("Buy", LookAt:=xlWhole)
Set wqslrng = .Rows(1).Find("Service Level", LookAt:=xlWhole)
Set wqsirng = .Rows(1).Find("Site", LookAt:=xlWhole)


' If at least one of the range objects Is Nothing, means that it was not found
' in worksheet QUOTE, then, we get a message box to give us a warning, and,
' then terminate the macro.
'
If (wqderng Is Nothing) * (wqskrng Is Nothing) * (wqsnrng Is Nothing) _
* (wqsdrng Is Nothing) * (wqedrng Is Nothing) * (wqqtrng Is Nothing) _
* (wqburng Is Nothing) * (wqslrng Is Nothing) * (wqsirng Is Nothing) Then
MsgBox "At least one of the 9 titles in sheet 'QUOTE' is missing - macro terminated!"
Exit Sub


' If ALL the range objects were found, then process the raw data in worksheet QUOTE
' into worksheet Sheet1
ElseIf (Not wqderng Is Nothing) * (Not wqskrng Is Nothing) * (Not wqsnrng Is Nothing) _
* (Not wqsdrng Is Nothing) * (Not wqedrng Is Nothing) * (Not wqqtrng Is Nothing) _
* (Not wqburng Is Nothing) * (Not wqslrng Is Nothing) * (Not wqsirng Is Nothing) Then


' Get the last used row in worksheet QUOTE
' for title "Description"
lr = .Cells(Rows.Count, wqderng.Column).End(xlUp).Row


' Convert the w1derng.Column into the column alpha character
' in this case is column "B"
strColName = Replace(.Cells(1, w1derng.Column).Address(0, 0), 1, "")


' Find the next available blank row in worksheet Sheet1
' in this case it is in column "B"
nr = Sheets("Sheet1").Range(strColName & Rows.Count).End(xlUp).Offset(1).Row



' Then copy from worksheet QUOTE range "B2:B lr
' into worksheet Sheet1
' in this case into column "B" nr
.Range(.Cells(2, wqderng.Column), .Cells(lr, wqderng.Column)).Copy Sheets("Sheet1").Cells(nr, w1derng.Column)


' in this case into column "C" nr
.Range(.Cells(2, wqskrng.Column), .Cells(lr, wqskrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1skrng.Column)

.Range(.Cells(2, wqsnrng.Column), .Cells(lr, wqsnrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1snrng.Column)
.Range(.Cells(2, wqsdrng.Column), .Cells(lr, wqsdrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1sdrng.Column)
.Range(.Cells(2, wqedrng.Column), .Cells(lr, wqedrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1edrng.Column)
.Range(.Cells(2, wqqtrng.Column), .Cells(lr, wqqtrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1qtrng.Column)
.Range(.Cells(2, wqburng.Column), .Cells(lr, wqburng.Column)).Copy Sheets("Sheet1").Cells(nr, w1burng.Column)
.Range(.Cells(2, wqslrng.Column), .Cells(lr, wqslrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1slrng.Column)
.Range(.Cells(2, wqsirng.Column), .Cells(lr, wqsirng.Column)).Copy Sheets("Sheet1").Cells(nr, w1sirng.Column)
End If
End With
With Sheets("Sheet1")
.Columns.AutoFit
.Activate
End With
End Sub
 
Upvote 0
longtimelurker,

I hope the below code and descriptions will help you to understand what the macro is doing.

One more try:


Option Explicit
Sub ReorgData()
' hiker95, 02/12/2014, ME756540
Dim lr As Long, nr As Long, strColName As String


' The following are the range objects for both worksheets
' Sheet1 = w1_QUOTE = wq
'__=w1_____________=wq
Dim w1derng As Range, wqderng As Range
Dim w1skrng As Range, wqsrng As Range
Dim w1snrng As Range, wqsnrng As Range
Dim w1sdrng As Range, wqsdrng As Range
Dim w1edrng As Range, wqedrng As Range
Dim w1qtrng As Range, wqqtrng As Range
Dim w1burng As Range, wqburng As Range
Dim w1slrng As Range, wqslrng As Range
Dim w1sirng As Range, wqsirng As Range


With Sheets("Sheet1")

' We want to set the range objects, find the range
' range objects for these Sheet1 titles
'____________in Row 1_______|
'__________________________|
Set w1derng = .Rows(1).Find("Description", LookAt:=xlWhole)
Set w1skrng = .Rows(1).Find("Covered SKU", LookAt:=xlWhole)
Set w1snrng = .Rows(1).Find("Serial No", LookAt:=xlWhole)
Set w1sdrng = .Rows(1).Find("Start Date", LookAt:=xlWhole)
Set w1edrng = .Rows(1).Find("End Date", LookAt:=xlWhole)
Set w1qtrng = .Rows(1).Find("Qty", LookAt:=xlWhole)
Set w1burng = .Rows(1).Find("Buy Price", LookAt:=xlWhole)
Set w1slrng = .Rows(1).Find("Service Level", LookAt:=xlWhole)
Set w1sirng = .Rows(1).Find("Host Name", LookAt:=xlWhole)


' If at least one of the range objects Is Nothing, means that it was not found
' in worksheet Sheet1, then, we get a message box to give us a warning, and,
' then terminate the macro.
'
If (w1derng Is Nothing) * (w1skrng Is Nothing) * (w1snrng Is Nothing) _
* (w1sdrng Is Nothing) * (w1edrng Is Nothing) * (w1qtrng Is Nothing) _
* (w1burng Is Nothing) * (w1slrng Is Nothing) * (w1sirng Is Nothing) Then
MsgBox "At least one of the 9 titles in sheet 'Sheet1' is missing - macro terminated!"
Exit Sub
End If
End With


With Sheets("QUOTE")


' We want to set the range objects, find the range
'___range objects_____for these QUOTE titles
'____________in Row 1_______|
'__________________________|
Set wqderng = .Rows(1).Find("Description", LookAt:=xlWhole)
Set wqskrng = .Rows(1).Find("Service Code", LookAt:=xlWhole)
Set wqsnrng = .Rows(1).Find("Serial Number", LookAt:=xlWhole)
Set wqsdrng = .Rows(1).Find("Start Date", LookAt:=xlWhole)
Set wqedrng = .Rows(1).Find("End Date", LookAt:=xlWhole)
Set wqqtrng = .Rows(1).Find("Qty", LookAt:=xlWhole)
Set wqburng = .Rows(1).Find("Buy", LookAt:=xlWhole)
Set wqslrng = .Rows(1).Find("Service Level", LookAt:=xlWhole)
Set wqsirng = .Rows(1).Find("Site", LookAt:=xlWhole)


' If at least one of the range objects Is Nothing, means that it was not found
' in worksheet QUOTE, then, we get a message box to give us a warning, and,
' then terminate the macro.
'
If (wqderng Is Nothing) * (wqskrng Is Nothing) * (wqsnrng Is Nothing) _
* (wqsdrng Is Nothing) * (wqedrng Is Nothing) * (wqqtrng Is Nothing) _
* (wqburng Is Nothing) * (wqslrng Is Nothing) * (wqsirng Is Nothing) Then
MsgBox "At least one of the 9 titles in sheet 'QUOTE' is missing - macro terminated!"
Exit Sub


' If ALL the range objects were found, then process the raw data in worksheet QUOTE
' into worksheet Sheet1
ElseIf (Not wqderng Is Nothing) * (Not wqskrng Is Nothing) * (Not wqsnrng Is Nothing) _
* (Not wqsdrng Is Nothing) * (Not wqedrng Is Nothing) * (Not wqqtrng Is Nothing) _
* (Not wqburng Is Nothing) * (Not wqslrng Is Nothing) * (Not wqsirng Is Nothing) Then


' Get the last used row in worksheet QUOTE
'______________for title_"Description"
lr = .Cells(Rows.Count, wqderng.Column).End(xlUp).Row


' Convert the w1derng.Column into the column alpha character
' in this case is column "B"
strColName = Replace(.Cells(1, w1derng.Column).Address(0, 0), 1, "")


' Find the next available blank row in worksheet Sheet
' in this case it is in column "B"
nr = Sheets("Sheet1").Range(strColName & Rows.Count).End(xlUp).Offset(1).Row


' Then copy from worksheet QUOTE range "B2:B lr
' into worksheet Sheet1
' in this case into column "B" nr
.Range(.Cells(2, wqderng.Column), .Cells(lr, wqderng.Column)).Copy Sheets("Sheet1").Cells(nr, w1derng.Column)


' in this case into column "C" nr
.Range(.Cells(2, wqskrng.Column), .Cells(lr, wqskrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1skrng.Column)

.Range(.Cells(2, wqsnrng.Column), .Cells(lr, wqsnrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1snrng.Column)
.Range(.Cells(2, wqsdrng.Column), .Cells(lr, wqsdrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1sdrng.Column)
.Range(.Cells(2, wqedrng.Column), .Cells(lr, wqedrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1edrng.Column)
.Range(.Cells(2, wqqtrng.Column), .Cells(lr, wqqtrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1qtrng.Column)
.Range(.Cells(2, wqburng.Column), .Cells(lr, wqburng.Column)).Copy Sheets("Sheet1").Cells(nr, w1burng.Column)
.Range(.Cells(2, wqslrng.Column), .Cells(lr, wqslrng.Column)).Copy Sheets("Sheet1").Cells(nr, w1slrng.Column)
.Range(.Cells(2, wqsirng.Column), .Cells(lr, wqsirng.Column)).Copy Sheets("Sheet1").Cells(nr, w1sirng.Column)
End If
End With
With Sheets("Sheet1")
.Columns.AutoFit
.Activate
End With
End Sub
 
Last edited:
Upvote 0
Hi Hiker95,

Thank you very much for the notes! After a little reading, I actually understand it!

It's so really clever, thank you very much for spending the time to help me understand & even build it in the first place! Thank you very much :)

Hopefully I can get to a stage where I can do something like this in a few years :D

Thank you again!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Complex Move data from two spreadsheets with similar data in different columns to a specific column in an existing spreadsheet(Sheet 3)
Replies
0
Views
138
JMC57
J
K
  • Question
Formula needed to look up specific name and enter data from specific column within same row
Replies
1
Views
212
awoohaw
awoohaw
T
  • Question
Sort Sheet By Date
2
Replies
11
Views
257
Alex Blakenburg
A
N
  • Question
Formula help to search a table for a date greater than today that has a non-blank cell and return the date in a separate cell.
Replies
2
Views
187
Alex Blakenburg
A
awanak
  • Question
Random Allocation of Halls
Replies
0
Views
94
awanak
awanak

Forum statistics

Threads
1,215,491
Messages
6,125,109
Members
449,205
Latest member
ralemanygarcia

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top