Mova cada célula após a coluna A na nova linha

Question

Eu gostaria de exportar alguns dados para o MySQL, mas antes disso eu gostaria de formatar os dados. Não sei como explicar, então fiz algumas capturas de tela.

Como eu poderia mudar isso:

Para isso?

1   23
1   5
1   20
2   3
2   5
3   67
3   24
3   653
3   43

A quantidade de colunas à direita após Column B pode ser infinita. Mas preciso colocar todas as coisas em Columns C,D,E...etc em uma nova linha em Column B .

Obrigado

    

Answer 1

Isto criará uma nova planilha chamada "For MySQL" e colocará o resultado lá:

Option Explicit
Public Sub rowToCol()
    Const FC As Long = 1    'first col (ID)
    Const FR As Long = 2    'first row
    Const NEXT_COL As Long = FC + 1
    Const DB_WS_NAME As String = "For MySQL"

    Dim ws As Worksheet, db As Worksheet, lr As Long, lc As Long, maxRow As Long
    Dim arr1 As Variant, arr2 As Variant, i As Long, j As Long, k As Long

    Set ws = Worksheets("Sheet1")   'main sheet -----------------------------------------
    lr = ws.Cells(ws.UsedRange.Rows.Count + 1, FC).End(xlUp).Row
    lc = ws.UsedRange.Columns.Count
    If lr >= FR Then
        maxRow = (lr - (FR - 1)) * (lc - FC) + FR   'set result area
        Application.ScreenUpdating = False: Application.DisplayAlerts = False
        For Each db In Worksheets
            If db.Name = DB_WS_NAME Then
                db.Delete: Exit For
            End If
        Next
        Set db = Worksheets.Add(After:=ws): db.Name = DB_WS_NAME
        arr1 = ws.Range(ws.Cells(FR, FC), ws.Cells(lr, lc)).Value2
        arr2 = db.Range(db.Cells(FR, FC), db.Cells(maxRow, NEXT_COL)).Value2
        k = FR - 1
        For i = FR - 1 To lr - (FR - 1) 'all rows
            For j = NEXT_COL To lc      'all cols
                If Len(arr1(i, j)) = 0 Then Exit For  'exit inner For (this row is done)
                arr2(k, FC) = arr1(i, FC)
                arr2(k, NEXT_COL) = arr1(i, j)
                k = k + 1
            Next
        Next
        db.Range(db.Cells(FR, FC), db.Cells(maxRow, NEXT_COL)).Value2 = arr2
        Application.DisplayAlerts = True: Application.ScreenUpdating = True
    End If
End Sub

Resultado:

    

Answer 2

Aqui está uma pequena macro para exportar diretamente seus dados para o arquivo de texto sem a necessidade de uma planilha adicional

• Altere "D:\sql_import.txt" para o caminho de saída desejado
• Altere [B2:E4] para o intervalo de entrada do Excel desejado

Código VBA

Sub ExportForSql()
    Open "D:\sql_import.txt" For Output As #1
    For Each cell In [B2:E4]
        If Not cell.Value = vbNullString Then
            Print #1, Cells(cell.Row, 1) & vbTab & cell.Value
        End If
    Next cell
    Close #1
End Sub

Ou você pode exportá-lo imediatamente com a sintaxe SQL correta usando algo semelhante a este

Print #1, "INSERT INTO " & Cells(cell.Row, 1) & " VALUES (" & cell.Value & ")"

Resultados com seus dados de exemplo